From 19addd38f80eba74a4b4682808fa9cf1a70af5e5 Mon Sep 17 00:00:00 2001 From: KenDickey Date: Sun, 22 Feb 2026 13:49:22 -0800 Subject: [PATCH 1/6] aarch64 requires include --- runtime/cpp/GCedRef.h | 3 +++ 1 file changed, 3 insertions(+) diff --git a/runtime/cpp/GCedRef.h b/runtime/cpp/GCedRef.h index aef4e11b..c68e5227 100644 --- a/runtime/cpp/GCedRef.h +++ b/runtime/cpp/GCedRef.h @@ -3,6 +3,9 @@ #define _GCEDREF_H_ #include "Egg.h" +#ifdef __aarch64__ +#include +#endif namespace Egg { From 13f94afdcc9805c4ddbfa2ac4ea5dfeef4fbcece Mon Sep 17 00:00:00 2001 From: KenDickey Date: Mon, 23 Feb 2026 13:40:44 -0800 Subject: [PATCH 2/6] Class Names --- .../PrintClasses/PrintClassesModule.st | 27 +++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 modules/Examples/PrintClasses/PrintClassesModule.st diff --git a/modules/Examples/PrintClasses/PrintClassesModule.st b/modules/Examples/PrintClasses/PrintClassesModule.st new file mode 100644 index 00000000..fd65586a --- /dev/null +++ b/modules/Examples/PrintClasses/PrintClassesModule.st @@ -0,0 +1,27 @@ +Class { + #name : #PrintClassesModule, + #superclass : #Module, + #category : #'Examples-PrintClasses' +} + +{ #category : #spec } +PrintClassesModule >> imports [ + ^{} +] + +{ #category: #private } +PrintClassesModule >> printAClass: aClass indent: indentCount [ + | aString | + indentCount timesRepeat: [ + Kernel log: ' '. + ]. + Kernel log: aClass printString, String cr. + aClass subclassesDo: [ :sub | self printAClass: sub indent: indentCount + 1 ]. +] + +{ #category : #services } +PrintClassesModule >> main: arguments [ + Kernel log: 'Current Local Classes', String cr. + self printAClass: Object class indent: 0. + ^0 +] From 664732fb7b5e4c4a0549513eef4accbc44909460 Mon Sep 17 00:00:00 2001 From: KenDickey Date: Sun, 28 Jun 2026 13:35:41 -0700 Subject: [PATCH 3/6] modules w Chunk format --- modules/JSON/Tests/JsonMappingTest.st | 2 +- modules/JSON/Tests/JsonParserTest.st | 2 +- modules/JSON/Tests/JsonSchemaTest.st | 2 +- modules/JSON/Tests/JsonSerializationTest.st | 2 +- modules/JSON/Tests/JsonWriterTest.st | 2 +- modules/LMR/Nativizer/Tests/TemplateJITTest.st | 2 +- modules/Tonel/Loader/TonelLoader.st | 4 ++-- 7 files changed, 8 insertions(+), 8 deletions(-) diff --git a/modules/JSON/Tests/JsonMappingTest.st b/modules/JSON/Tests/JsonMappingTest.st index e72b236b..97ab6151 100644 --- a/modules/JSON/Tests/JsonMappingTest.st +++ b/modules/JSON/Tests/JsonMappingTest.st @@ -6,7 +6,7 @@ Class { #name : #JsonMappingTest, #superclass : #TestCase, - #category : #'JSON\Tests' + #category : #'JSON-Tests' } { #category : #all } diff --git a/modules/JSON/Tests/JsonParserTest.st b/modules/JSON/Tests/JsonParserTest.st index 32582b2f..cde73460 100644 --- a/modules/JSON/Tests/JsonParserTest.st +++ b/modules/JSON/Tests/JsonParserTest.st @@ -6,7 +6,7 @@ Class { #name : #JsonParserTest, #superclass : #TestCase, - #category : #'JSON\Tests' + #category : #'JSON-Tests' } { #category : #private } diff --git a/modules/JSON/Tests/JsonSchemaTest.st b/modules/JSON/Tests/JsonSchemaTest.st index 865b8f3c..f926e463 100644 --- a/modules/JSON/Tests/JsonSchemaTest.st +++ b/modules/JSON/Tests/JsonSchemaTest.st @@ -6,7 +6,7 @@ Class { #name : #JsonSchemaTest, #superclass : #TestCase, - #category : #'JSON\Tests' + #category : #'JSON-Tests' } { #category : #validation } diff --git a/modules/JSON/Tests/JsonSerializationTest.st b/modules/JSON/Tests/JsonSerializationTest.st index 57af3a2d..d00680c2 100644 --- a/modules/JSON/Tests/JsonSerializationTest.st +++ b/modules/JSON/Tests/JsonSerializationTest.st @@ -6,7 +6,7 @@ Class { #name : #JsonSerializationTest, #superclass : #TestCase, - #category : #'JSON\Tests' + #category : #'JSON-Tests' } { #category : #all } diff --git a/modules/JSON/Tests/JsonWriterTest.st b/modules/JSON/Tests/JsonWriterTest.st index 08328567..b273559a 100644 --- a/modules/JSON/Tests/JsonWriterTest.st +++ b/modules/JSON/Tests/JsonWriterTest.st @@ -6,7 +6,7 @@ Class { #name : #JsonWriterTest, #superclass : #TestCase, - #category : #'JSON\Tests' + #category : #'JSON-Tests' } { #category : #utf8 } diff --git a/modules/LMR/Nativizer/Tests/TemplateJITTest.st b/modules/LMR/Nativizer/Tests/TemplateJITTest.st index 560bce5d..71341bfe 100644 --- a/modules/LMR/Nativizer/Tests/TemplateJITTest.st +++ b/modules/LMR/Nativizer/Tests/TemplateJITTest.st @@ -3,7 +3,7 @@ Class { #superclass : #Object, #instVars : [ 'environment' - ] + ], #category : #'Nativization-Tests' } diff --git a/modules/Tonel/Loader/TonelLoader.st b/modules/Tonel/Loader/TonelLoader.st index 2c55060f..711c9b7c 100644 --- a/modules/Tonel/Loader/TonelLoader.st +++ b/modules/Tonel/Loader/TonelLoader.st @@ -7,7 +7,7 @@ Class { #name : #TonelLoader, #superclass : #Object, #instVars : [ - 'moduleDir', + 'moduleDir' ], #category : #Tonel } @@ -152,4 +152,4 @@ TonelLoader >> readSpec: specName atDir: dir [ class := module ensureClassNamed: mdef className. class addMethodFromDefinition: mdef in: module ]. ^ module -] \ No newline at end of file +] From d256d818e8b07817c83ccbdf31e7d3261fe01833 Mon Sep 17 00:00:00 2001 From: KenDickey Date: Sun, 28 Jun 2026 13:38:06 -0700 Subject: [PATCH 4/6] modules w Chunk format --- modules/ArgParser/ArgParser.Class.st | 108 + modules/ArgParser/ArgParserModule.Class.st | 28 + modules/ArgParser/Command.Class.st | 163 + modules/ArgParser/Option.Class.st | 102 + modules/ArgParser/ParseResult.Class.st | 79 + modules/CodeSpecs/ClassSpec.Class.st | 151 + modules/CodeSpecs/CodeSpecsModule.Class.st | 28 + modules/CodeSpecs/MetaclassSpec.Class.st | 79 + modules/CodeSpecs/MethodSpec.Class.st | 191 + modules/CodeSpecs/ModuleSpec.Class.st | 362 ++ modules/CodeSpecs/SpeciesSpec.Class.st | 190 + modules/Compiler/ArgumentBinding.Class.st | 59 + modules/Compiler/ArgumentEnvironment.Class.st | 20 + modules/Compiler/ArrayEnvironment.Class.st | 45 + modules/Compiler/Binding.Class.st | 141 + modules/Compiler/BlockScope.Class.st | 241 + modules/Compiler/CompilerModule.Class.st | 47 + modules/Compiler/DynamicBinding.Class.st | 51 + modules/Compiler/FalseBinding.Class.st | 30 + modules/Compiler/IdentifierBinder.Class.st | 35 + .../Compiler/InlinedArgEnvironment.Class.st | 25 + modules/Compiler/LiteralBinding.Class.st | 20 + modules/Compiler/LocalBinding.Class.st | 80 + modules/Compiler/LocalEnvironment.Class.st | 20 + modules/Compiler/MessageInliner.Class.st | 204 + modules/Compiler/MethodScope.Class.st | 82 + .../Compiler/NestedDynamicBinding.Class.st | 30 + modules/Compiler/NilBinding.Class.st | 30 + modules/Compiler/SAssignmentNode.Class.st | 74 + modules/Compiler/SBlockNode.Class.st | 116 + modules/Compiler/SBraceNode.Class.st | 76 + modules/Compiler/SCascadeMessageNode.Class.st | 47 + modules/Compiler/SCascadeNode.Class.st | 59 + modules/Compiler/SCommentNode.Class.st | 30 + modules/Compiler/SCompilationError.Class.st | 84 + modules/Compiler/SCompilationResult.Class.st | 55 + modules/Compiler/SCompiler.Class.st | 120 + modules/Compiler/SDelimiterToken.Class.st | 45 + modules/Compiler/SEndToken.Class.st | 35 + modules/Compiler/SFFIDescriptor.Class.st | 100 + modules/Compiler/SIdentifierNode.Class.st | 169 + modules/Compiler/SInvalidPragmaError.Class.st | 15 + modules/Compiler/SLiteralNode.Class.st | 55 + modules/Compiler/SMessageNode.Class.st | 129 + modules/Compiler/SMethodNode.Class.st | 174 + modules/Compiler/SNumberNode.Class.st | 30 + modules/Compiler/SParseNode.Class.st | 140 + modules/Compiler/SParseTreeVisitor.Class.st | 105 + modules/Compiler/SPragmaNode.Class.st | 63 + modules/Compiler/SReturnNode.Class.st | 51 + modules/Compiler/SScriptNode.Class.st | 127 + modules/Compiler/SSelectorNode.Class.st | 72 + modules/Compiler/SSemanticVisitor.Class.st | 133 + modules/Compiler/SSmalltalkCompiler.Class.st | 295 + modules/Compiler/SSmalltalkParser.Class.st | 905 +++ modules/Compiler/SSmalltalkScanner.Class.st | 314 + modules/Compiler/SStringNode.Class.st | 20 + modules/Compiler/SStringToken.Class.st | 58 + modules/Compiler/SSymbolicToken.Class.st | 30 + modules/Compiler/SToken.Class.st | 187 + .../SUndeclaredIdentifierError.Class.st | 41 + modules/Compiler/ScriptScope.Class.st | 155 + modules/Compiler/SelfBinding.Class.st | 40 + modules/Compiler/Species.Extension.st | 11 + modules/Compiler/StackEnvironment.Class.st | 25 + modules/Compiler/StaticBinder.Class.st | 77 + modules/Compiler/SuperBinding.Class.st | 35 + modules/Compiler/TemporaryBinding.Class.st | 38 + .../Tests/MessageInlinerTest.Class.st | 82 + .../Tests/SmalltalkScannerTest.Class.st | 400 ++ modules/Compiler/Tests/TestsModule.Class.st | 46 + modules/Compiler/TreecodeEncoder.Class.st | 351 ++ modules/Compiler/TrueBinding.Class.st | 30 + .../Development/BeginningCondition.Class.st | 31 + modules/Development/ClassSearch.Class.st | 29 + modules/Development/CodeSearch.Class.st | 169 + .../Development/CodeSearchCondition.Class.st | 132 + modules/Development/CodeSearchResult.Class.st | 80 + .../Development/CompiledMethod.Extension.st | 36 + .../Development/DevelopmentModule.Class.st | 33 + modules/Development/EndingCondition.Class.st | 31 + .../Development/ExactMatchCondition.Class.st | 36 + .../Development/IncludingCondition.Class.st | 31 + modules/Development/MethodSearch.Class.st | 190 + .../Development/MethodSearchScope.Class.st | 181 + modules/Development/PatternCondition.Class.st | 41 + .../Development/SimilarityCondition.Class.st | 44 + modules/EPM/Config.Class.st | 133 + modules/EPM/EPMModule.Class.st | 184 + modules/EPM/ProjectGenerator.Class.st | 96 + .../Examples/HTTPServer/ExampleAPI.Class.st | 33 + .../HTTPServer/HTTPServerModule.Class.st | 46 + .../HelloWorld/HelloWorldModule.Class.st | 26 + .../PrintClasses/PrintClassesModule.Class.st | 37 + modules/FFI/ByteArray.Extension.st | 24 + modules/FFI/ByteArraySegment.Extension.st | 9 + modules/FFI/CallbackBehavior.Class.st | 31 + modules/FFI/CallbackMethod.Class.st | 46 + modules/FFI/CharacterArray.Extension.st | 9 + modules/FFI/ExternalHandle.Class.st | 47 + modules/FFI/ExternalHeap.Class.st | 33 + modules/FFI/ExternalLibrary.Class.st | 80 + modules/FFI/ExternalMemory.Class.st | 566 ++ modules/FFI/ExternalObject.Class.st | 52 + modules/FFI/FFIDescriptor.Class.st | 66 + modules/FFI/FFIMethod.Class.st | 56 + modules/FFI/FFIModule.Class.st | 100 + modules/FFI/Float.Extension.st | 9 + modules/FFI/Integer.Extension.st | 19 + modules/FFI/LibC.Class.st | 46 + modules/FFI/LibraryLoader.Class.st | 34 + modules/FFI/MallocHeap.Class.st | 42 + modules/FFI/Object.Extension.st | 9 + modules/FFI/Posix/DLLibrary.Class.st | 47 + modules/FFI/Posix/PosixLibraryLoader.Class.st | 90 + modules/FFI/Posix/PosixModule.Class.st | 31 + modules/FFI/String.Extension.st | 20 + modules/FFI/Tests/TestLibrary.Class.st | 41 + modules/FFI/Tests/TestsModule.Class.st | 42 + modules/FFI/Windows/KernelDLL.Class.st | 38 + .../FFI/Windows/WindowsLibraryLoader.Class.st | 60 + modules/FFI/Windows/WindowsModule.Class.st | 31 + modules/Filesystem/Directory.Class.st | 38 + modules/Filesystem/File.Class.st | 31 + modules/Filesystem/FilesystemEntry.Class.st | 56 + modules/Filesystem/FilesystemModule.Class.st | 33 + .../Native/CPPFilesystemLibrary.Class.st | 81 + .../Filesystem/Native/NativeFSModule.Class.st | 33 + modules/Filesystem/Node/NodeFSModule.Class.st | 31 + .../Node/NodeFilesystemLibrary.Class.st | 81 + modules/Filesystem/Path.Class.st | 64 + modules/Filesystem/String.Extension.st | 9 + .../CPPHTTPServerModule.Class.st | 33 + .../HTTP/CPPHTTPServer/HTTPMessage.Class.st | 31 + .../HTTP/CPPHTTPServer/HTTPObject.Class.st | 21 + .../HTTP/CPPHTTPServer/HTTPRequest.Class.st | 69 + .../HTTP/CPPHTTPServer/HTTPResponse.Class.st | 51 + .../HTTP/CPPHTTPServer/HTTPServer.Class.st | 60 + .../CPPHTTPServer/HTTPServerLibrary.Class.st | 101 + .../ImageSegmentBuilder/Behavior.Extension.st | 15 + .../ImageSegmentBuilder/Boolean.Extension.st | 9 + modules/ImageSegmentBuilder/Builder.Class.st | 125 + .../Character.Extension.st | 14 + .../ImageSegmentBuilder/Class.Extension.st | 14 + .../ImageSegmentBuilder/False.Extension.st | 9 + .../ImageSegmentBuilderModule.Class.st | 31 + .../JSON/JSONModule.Class.st | 41 + .../JSON/JSONWriter.Class.st | 159 + .../Metaclass.Extension.st | 14 + .../ImageSegmentBuilder/Module.Extension.st | 29 + .../Native/NativeModule.Class.st | 55 + .../Native/NativeWriter.Class.st | 345 + .../ImageSegmentBuilder/Object.Extension.st | 9 + .../ObjectClosure.Class.st | 159 + .../ImageSegmentBuilder/Symbol.Extension.st | 14 + modules/ImageSegmentBuilder/True.Extension.st | 9 + .../UndefinedObject.Extension.st | 14 + modules/ImageSegmentBuilder/Writer.Class.st | 78 + modules/JSON/BooleanAdaptor.Class.st | 31 + modules/JSON/DataAdaptor.Class.st | 38 + modules/JSON/IdAdaptor.Class.st | 52 + modules/JSON/JsonAnySchema.Class.st | 31 + modules/JSON/JsonArraySchema.Class.st | 85 + modules/JSON/JsonBooleanSchema.Class.st | 26 + modules/JSON/JsonCombinedSchema.Class.st | 37 + modules/JSON/JsonDateFormat.Class.st | 21 + modules/JSON/JsonDateTimeFormat.Class.st | 21 + modules/JSON/JsonEmailFormat.Class.st | 21 + modules/JSON/JsonError.Class.st | 56 + modules/JSON/JsonFormat.Class.st | 21 + modules/JSON/JsonImporter.Class.st | 108 + modules/JSON/JsonImporterError.Class.st | 21 + modules/JSON/JsonIntegerFormat.Class.st | 21 + modules/JSON/JsonIntegerSchema.Class.st | 31 + modules/JSON/JsonMapping.Class.st | 220 + modules/JSON/JsonMappingRegistry.Class.st | 87 + modules/JSON/JsonModule.Class.st | 27 + modules/JSON/JsonNotSchema.Class.st | 42 + modules/JSON/JsonNullSchema.Class.st | 31 + modules/JSON/JsonNumberFormat.Class.st | 21 + modules/JSON/JsonNumberSchema.Class.st | 113 + modules/JSON/JsonObject.Class.st | 93 + modules/JSON/JsonObjectSchema.Class.st | 93 + modules/JSON/JsonOneSchema.Class.st | 31 + modules/JSON/JsonPainter.Class.st | 116 + modules/JSON/JsonParser.Class.st | 295 + modules/JSON/JsonPrimitiveSchema.Class.st | 46 + modules/JSON/JsonPropertyMap.Class.st | 169 + modules/JSON/JsonSchema.Class.st | 286 + modules/JSON/JsonSchemaReference.Class.st | 84 + modules/JSON/JsonSerializer.Class.st | 219 + modules/JSON/JsonStringFormat.Class.st | 21 + modules/JSON/JsonStringSchema.Class.st | 60 + modules/JSON/JsonUriFormat.Class.st | 21 + modules/JSON/JsonWriter.Class.st | 336 + modules/JSON/Object.Extension.st | 14 + modules/JSON/StringAdaptor.Class.st | 29 + modules/JSON/SymbolAdaptor.Class.st | 26 + modules/JSON/Tests/JsonMappingTest.Class.st | 65 + modules/JSON/Tests/JsonParserTest.Class.st | 43 + modules/JSON/Tests/JsonSchemaTest.Class.st | 335 + .../JSON/Tests/JsonSerializationTest.Class.st | 249 + modules/JSON/Tests/JsonWriterTest.Class.st | 66 + modules/JSON/TimestampAdaptor.Class.st | 44 + modules/JSON/TypeAdaptor.Class.st | 50 + modules/Kernel/Abort.Class.st | 21 + modules/Kernel/ActionSequence.Class.st | 69 + modules/Kernel/ActiveProcess.Class.st | 142 + modules/Kernel/Ansi.Class.st | 85 + modules/Kernel/ArithmeticError.Class.st | 104 + modules/Kernel/Array.Class.st | 54 + modules/Kernel/ArrayedCollection.Class.st | 407 ++ modules/Kernel/AssertionFailure.Class.st | 26 + modules/Kernel/Association.Class.st | 91 + modules/Kernel/Bag.Class.st | 194 + .../Kernel/BareTests/BareTestsModule.Class.st | 466 ++ modules/Kernel/BeeTranscript.Class.st | 30 + modules/Kernel/Behavior.Class.st | 175 + modules/Kernel/Boolean.Class.st | 76 + modules/Kernel/BootstrapDictionary.Class.st | 41 + modules/Kernel/ByteArray.Class.st | 267 + modules/Kernel/ByteArraySegment.Class.st | 248 + modules/Kernel/Character.Class.st | 848 +++ modules/Kernel/CharacterArray.Class.st | 791 +++ modules/Kernel/Class.Class.st | 347 ++ modules/Kernel/ClassOrganizer.Class.st | 300 + modules/Kernel/Closure.Class.st | 379 ++ modules/Kernel/Collection.Class.st | 514 ++ modules/Kernel/CommandLine.Class.st | 274 + modules/Kernel/CompiledBlock.Class.st | 320 + modules/Kernel/CompiledExpression.Class.st | 46 + modules/Kernel/CompiledMethod.Class.st | 498 ++ modules/Kernel/CompositeCollection.Class.st | 255 + modules/Kernel/Context.Class.st | 150 + modules/Kernel/Date.Class.st | 21 + modules/Kernel/Delay.Class.st | 101 + modules/Kernel/DeletedClass.Class.st | 39 + modules/Kernel/Dictionary.Class.st | 396 ++ modules/Kernel/EndOfStream.Class.st | 26 + modules/Kernel/Ephemeron.Class.st | 108 + modules/Kernel/Error.Class.st | 26 + modules/Kernel/EventHandlerMessage.Class.st | 46 + modules/Kernel/Exception.Class.st | 241 + modules/Kernel/ExceptionHandler.Class.st | 137 + modules/Kernel/ExceptionSet.Class.st | 65 + modules/Kernel/False.Class.st | 131 + modules/Kernel/Float.Class.st | 859 +++ modules/Kernel/FloatUnderflow.Class.st | 31 + modules/Kernel/Fraction.Class.st | 306 + modules/Kernel/Halt.Class.st | 26 + modules/Kernel/HashTable.Class.st | 430 ++ modules/Kernel/HashTablePolicy.Class.st | 151 + modules/Kernel/HashedCollection.Class.st | 327 + modules/Kernel/HostSystem.Class.st | 224 + modules/Kernel/IdentityDictionary.Class.st | 36 + modules/Kernel/IdentitySet.Class.st | 36 + modules/Kernel/ImageSegment.Class.st | 37 + modules/Kernel/InlinedDictionary.Class.st | 109 + modules/Kernel/InlinedHashTable.Class.st | 155 + modules/Kernel/Integer.Class.st | 549 ++ modules/Kernel/InternalReadStream.Class.st | 318 + modules/Kernel/InternalWriteStream.Class.st | 348 ++ modules/Kernel/Interval.Class.st | 138 + modules/Kernel/KernelModule.Class.st | 302 + modules/Kernel/KeyNotFound.Class.st | 38 + .../Kernel/LMR/LMRArrayedCollection.Class.st | 26 + modules/Kernel/LMR/LMRCharacterArray.Class.st | 26 + modules/Kernel/LMR/LMRClosure.Class.st | 88 + modules/Kernel/LMR/LMRFloat.Class.st | 195 + modules/Kernel/LMR/LMRModule.Class.st | 28 + modules/Kernel/LMR/LMRObject.Class.st | 26 + modules/Kernel/LMR/LMRProtoObject.Class.st | 457 ++ modules/Kernel/LMR/LMRSmallInteger.Class.st | 112 + modules/Kernel/LMR/LMRSpecies.Class.st | 100 + modules/Kernel/LMR/LMRSymbol.Class.st | 27 + modules/Kernel/LargeInteger.Class.st | 540 ++ modules/Kernel/LargeNegativeInteger.Class.st | 190 + modules/Kernel/LargePositiveInteger.Class.st | 320 + modules/Kernel/LaunchContext.Class.st | 52 + modules/Kernel/LinkedCollection.Class.st | 120 + modules/Kernel/Locale.Class.st | 199 + modules/Kernel/Magnitude.Class.st | 71 + modules/Kernel/MatchAlgorithm.Class.st | 183 + modules/Kernel/MatchToken.Class.st | 119 + modules/Kernel/Message.Class.st | 142 + modules/Kernel/MessageNotUnderstood.Class.st | 83 + modules/Kernel/MessageSend.Class.st | 112 + modules/Kernel/Metaclass.Class.st | 133 + modules/Kernel/MethodDictionary.Class.st | 131 + modules/Kernel/Module.Class.st | 259 + modules/Kernel/Namespace.Class.st | 40 + modules/Kernel/Notification.Class.st | 26 + modules/Kernel/Number.Class.st | 510 ++ modules/Kernel/NumberParser.Class.st | 235 + modules/Kernel/Object.Class.st | 1117 ++++ modules/Kernel/ObjectReference.Class.st | 116 + modules/Kernel/OpenHashTable.Class.st | 126 + modules/Kernel/OrderedCollection.Class.st | 496 ++ modules/Kernel/OrderedDictionary.Class.st | 122 + modules/Kernel/OrderedHashTable.Class.st | 240 + modules/Kernel/Point.Class.st | 293 + modules/Kernel/Process.Class.st | 156 + modules/Kernel/ProcessStack.Class.st | 71 + modules/Kernel/ProcessStackChunk.Class.st | 101 + modules/Kernel/ProcessVMStack.Class.st | 99 + modules/Kernel/ProcessorScheduler.Class.st | 108 + modules/Kernel/ProtoObject.Class.st | 450 ++ modules/Kernel/ReadStream.Class.st | 625 ++ modules/Kernel/ReadWriteStream.Class.st | 243 + modules/Kernel/Rectangle.Class.st | 508 ++ modules/Kernel/Recursion.Class.st | 72 + modules/Kernel/ScaledDecimal.Class.st | 294 + modules/Kernel/Semaphore.Class.st | 85 + .../Kernel/SequenceableCollection.Class.st | 836 +++ modules/Kernel/Set.Class.st | 62 + modules/Kernel/SmallInteger.Class.st | 405 ++ modules/Kernel/SmalltalkSession.Class.st | 94 + modules/Kernel/SmalltalkSystem.Class.st | 391 ++ modules/Kernel/SortedCollection.Class.st | 208 + modules/Kernel/Species.Class.st | 553 ++ modules/Kernel/StackOverflow.Class.st | 26 + modules/Kernel/StarToken.Class.st | 54 + modules/Kernel/Stream.Class.st | 99 + modules/Kernel/Stretch.Class.st | 134 + modules/Kernel/String.Class.st | 747 +++ modules/Kernel/StringPattern.Class.st | 112 + modules/Kernel/SuspendedProcess.Class.st | 71 + modules/Kernel/Symbol.Class.st | 387 ++ modules/Kernel/SymbolicReference.Class.st | 186 + modules/Kernel/Time.Class.st | 30 + modules/Kernel/Timer.Class.st | 120 + modules/Kernel/Timestamp.Class.st | 21 + modules/Kernel/True.Class.st | 121 + modules/Kernel/UTF16.Class.st | 165 + modules/Kernel/UTF32.Class.st | 36 + modules/Kernel/UTF8.Class.st | 224 + modules/Kernel/UndefinedObject.Class.st | 131 + modules/Kernel/Unicode.Class.st | 193 + modules/Kernel/VM/Closure.Extension.st | 49 + modules/Kernel/VM/CompiledMethod.Extension.st | 14 + modules/Kernel/VM/Float.Extension.st | 129 + modules/Kernel/VM/HashTable.Extension.st | 9 + modules/Kernel/VM/Namespace.Extension.st | 9 + modules/Kernel/VM/ProcessStack.Extension.st | 9 + modules/Kernel/VM/ProtoObject.Extension.st | 76 + modules/Kernel/VM/SmallInteger.Extension.st | 104 + modules/Kernel/VM/Species.Extension.st | 29 + modules/Kernel/VM/String.Extension.st | 20 + modules/Kernel/VM/Symbol.Extension.st | 9 + modules/Kernel/Warning.Class.st | 26 + modules/Kernel/WeakArray.Class.st | 29 + .../Kernel/WeakIdentityDictionary.Class.st | 86 + modules/Kernel/WeakIdentitySet.Class.st | 88 + modules/Kernel/WideString.Class.st | 506 ++ modules/Kernel/WideSymbol.Class.st | 152 + modules/Kernel/WriteStream.Class.st | 232 + modules/Kernel/WriteStringStream.Class.st | 45 + modules/Kernel/ZeroDivide.Class.st | 52 + modules/LMR/AllocationZone.Class.st | 292 + modules/LMR/Allocator.Class.st | 57 + modules/LMR/CopyingCollector.Class.st | 177 + modules/LMR/CriticalArray.Class.st | 187 + modules/LMR/CriticalStack.Class.st | 110 + modules/LMR/DispatchSite.Class.st | 21 + modules/LMR/EdenCollector.Class.st | 417 ++ modules/LMR/GCSpace.Class.st | 600 ++ modules/LMR/GarbageCollector.Class.st | 353 ++ modules/LMR/GarbageFirstCollector.Class.st | 119 + modules/LMR/GenGCPass.Class.st | 176 + modules/LMR/GlobalDispatchCache.Class.st | 198 + modules/LMR/LMRModule.Class.st | 147 + modules/LMR/Memory.Class.st | 944 +++ modules/LMR/MemoryMeter.Class.st | 107 + modules/LMR/NativeCode.Class.st | 106 + modules/LMR/Nativizer/Assembly/ABI.Class.st | 120 + .../LMR/Nativizer/Assembly/Assembler.Class.st | 1774 ++++++ .../Nativizer/Assembly/CodeGenerator.Class.st | 659 ++ .../Assembly/GenericAssembler.Class.st | 1859 ++++++ .../Intel/AMD64CodeGenerator.Class.st | 1073 ++++ .../Intel/AMD64TemplateAssembler.Class.st | 1301 ++++ .../Assembly/Intel/ISAImmediate.Class.st | 116 + .../Assembly/Intel/ISAInstruction.Class.st | 325 + .../Assembly/Intel/ISAOperand.Class.st | 130 + .../Assembly/Intel/ISAOperandType.Class.st | 474 ++ .../Intel/InstructionEncoder.Class.st | 603 ++ .../Assembly/Intel/InstructionPrefix.Class.st | 119 + .../Assembly/Intel/InstructionSpec.Class.st | 3258 ++++++++++ .../Assembly/Intel/IntelModule.Class.st | 39 + .../Assembly/Intel/LegacyPrefix.Class.st | 141 + .../Assembly/Intel/MemoryOperand.Class.st | 343 + .../Assembly/Intel/OperandEncoding.Class.st | 994 +++ .../Intel/Parser/AssemblerGrammar.Class.st | 213 + .../Intel/Parser/AssemblerParser.Class.st | 216 + .../Assembly/Intel/Parser/Assembly.Class.st | 61 + .../Assembly/Intel/REXPrefix.Class.st | 110 + .../Assembly/Intel/Register.Class.st | 454 ++ .../Assembly/Intel/SegmentPrefix.Class.st | 102 + .../Assembly/Intel/SysVX64ABI.Class.st | 56 + .../Tools/ISAInstructionPartReader.Class.st | 31 + .../Intel/Tools/ISAInstructionReader.Class.st | 93 + .../Intel/Tools/ISAModRMReader.Class.st | 31 + .../Intel/Tools/ISAOpcodeReader.Class.st | 41 + .../Intel/Tools/ISAPrefixReader.Class.st | 135 + .../Intel/Tools/ISASibReader.Class.st | 31 + .../Assembly/Intel/Tools/ModRM.Class.st | 85 + .../Intel/Tools/OctalStructure.Class.st | 87 + .../Assembly/Intel/Tools/SIB.Class.st | 68 + .../Assembly/Intel/VEXPrefix.Class.st | 304 + .../Assembly/Intel/WinX64ABI.Class.st | 60 + .../Nativizer/Assembly/Intel/X64ABI.Class.st | 121 + .../Nativizer/Assembly/Intel/X86ABI.Class.st | 71 + .../Assembly/NativeCodeReference.Class.st | 85 + .../Assembly/RISCCodeGenerator.Class.st | 73 + .../Assembly/RISCV/RV64CodeGenerator.Class.st | 15 + .../Assembly/RISCV/RegistersRISCV.Class.st | 15 + .../Assembly/RelocatableBuffer.Class.st | 192 + .../Assembly/RelocationFixup.Class.st | 96 + .../Nativizer/BinaryMessageNativizer.Class.st | 444 ++ .../Nativizer/CompositeMessageLinker.Class.st | 49 + modules/LMR/Nativizer/HaltingSend.Class.st | 20 + .../Nativizer/InlineMessageLinker.Class.st | 984 +++ .../InlinedMessageNativizer.Class.st | 535 ++ modules/LMR/Nativizer/InvokeLinker.Class.st | 58 + modules/LMR/Nativizer/LazyLinker.Class.st | 37 + modules/LMR/Nativizer/LookupLinker.Class.st | 56 + .../LMR/Nativizer/LookupNativizer.Class.st | 119 + modules/LMR/Nativizer/MessageLinker.Class.st | 28 + .../NativizationEnvironment.Class.st | 219 + .../Nativizer/NativizationPlatform.Class.st | 143 + .../LMR/Nativizer/NativizerModule.Class.st | 268 + .../OCompiler/IR/OActivationContext.Class.st | 65 + .../OCompiler/IR/OBasicBlock.Class.st | 837 +++ .../OCompiler/IR/OBeginInstruction.Class.st | 76 + .../IR/OBinaryConstantOperation.Class.st | 48 + .../OCompiler/IR/OBinaryOperation.Class.st | 96 + .../IR/OBinaryVariableOperation.Class.st | 49 + .../OCompiler/IR/OBlockClosure.Class.st | 51 + .../OCompiler/IR/OComposedLiveRange.Class.st | 114 + .../Nativizer/OCompiler/IR/OConstant.Class.st | 21 + .../OCompiler/IR/ODefineArgument.Class.st | 66 + .../OCompiler/IR/ODominatorTree.Class.st | 115 + .../OCompiler/IR/OEndInstruction.Class.st | 87 + .../OCompiler/IR/OInstruction.Class.st | 578 ++ .../LMR/Nativizer/OCompiler/IR/OJump.Class.st | 81 + .../OCompiler/IR/OJumpConditional.Class.st | 115 + .../OCompiler/IR/OJumpFalse.Class.st | 57 + .../Nativizer/OCompiler/IR/OJumpTrue.Class.st | 56 + .../OCompiler/IR/OLiveRange.Class.st | 32 + .../OCompiler/IR/OLoadConstant.Class.st | 78 + .../OCompiler/IR/OLoadImplicit.Class.st | 94 + .../OCompiler/IR/OMessageSend.Class.st | 127 + .../Nativizer/OCompiler/IR/OOperand.Class.st | 128 + .../LMR/Nativizer/OCompiler/IR/OPhi.Class.st | 207 + .../OCompiler/IR/OPrimitiveOperation.Class.st | 51 + .../OCompiler/IR/OReadVariable.Class.st | 71 + .../Nativizer/OCompiler/IR/OReturn.Class.st | 94 + .../OCompiler/IR/OSimpleLiveRange.Class.st | 141 + .../OCompiler/IR/OTemporary.Class.st | 21 + .../OCompiler/IR/OTernaryOperation.Class.st | 122 + .../Nativizer/OCompiler/IR/OTiling.Class.st | 68 + .../OCompiler/IR/OUnaryOperation.Class.st | 81 + .../OCompiler/IR/OUseVariable.Class.st | 31 + .../Nativizer/OCompiler/IR/OValue.Class.st | 21 + .../Nativizer/OCompiler/IR/OVariable.Class.st | 47 + .../OCompiler/IR/OWriteVariable.Class.st | 89 + .../OCompiler/IR/Object.Extension.st | 29 + .../NativizationEnvironment.Extension.st | 61 + .../Nativizer/OCompiler/Object.Extension.st | 9 + .../OCompiler/OptimizingBlockInliner.Class.st | 197 + .../OptimizingBraunAllocator.Class.st | 449 ++ .../OptimizingBraunAssigner.Class.st | 344 + .../OptimizingCFGSimplifier.Class.st | 133 + .../OptimizingCSSATransformer.Class.st | 54 + .../OCompiler/OptimizingCodeEmitter.Class.st | 908 +++ .../OptimizingInstructionFragmenter.Class.st | 447 ++ .../OptimizingInstructionSelector.Class.st | 436 ++ .../OptimizingLivenessAnalysis.Class.st | 143 + .../OptimizingMethodInliner.Class.st | 99 + .../OCompiler/OptimizingNativizer.Class.st | 258 + .../OptimizingPhiSimplification.Class.st | 62 + .../OptimizingRegisterAllocator.Class.st | 559 ++ .../OptimizingSSAReconstructor.Class.st | 98 + .../OptimizingTwoAddressEnforcer.Class.st | 182 + .../OCompiler/OptimizingUsesVerifier.Class.st | 106 + .../OptimizingValueNumbering.Class.st | 281 + .../OptimizingVariableBinder.Class.st | 372 ++ .../OCompiler/OptimizingVisitor.Class.st | 191 + modules/LMR/Nativizer/TemplateJIT.Class.st | 751 +++ .../LMR/Nativizer/Tests/TemplateJIT.Class.st | 154 + modules/LMR/NonMovingCollector.Class.st | 254 + modules/LMR/PinnedAllocator.Class.st | 26 + modules/LMR/ReifiedStackFrameCursor.Class.st | 41 + modules/LMR/RememberedSet.Class.st | 103 + .../SExpressions/CompiledMethod.Extension.st | 13 + .../SExpressions/SArgumentBinding.Class.st | 49 + modules/LMR/SExpressions/SAssignment.Class.st | 78 + .../SExpressions/SAssociationBinding.Class.st | 55 + modules/LMR/SExpressions/SBinding.Class.st | 101 + modules/LMR/SExpressions/SBlock.Class.st | 98 + modules/LMR/SExpressions/SCascade.Class.st | 50 + .../LMR/SExpressions/SCascadeMessage.Class.st | 108 + .../LMR/SExpressions/SDynamicBinding.Class.st | 63 + modules/LMR/SExpressions/SExpression.Class.st | 85 + .../SExpressions/SExpressionsModule.Class.st | 27 + .../LMR/SExpressions/SFalseBinding.Class.st | 30 + modules/LMR/SExpressions/SIdentifier.Class.st | 94 + .../SExpressions/SInlinerOperation.Class.st | 15 + .../LMR/SExpressions/SInstVarBinding.Class.st | 50 + modules/LMR/SExpressions/SLiteral.Class.st | 49 + .../LMR/SExpressions/SLiteralBinding.Class.st | 25 + modules/LMR/SExpressions/SLiteralVar.Class.st | 25 + .../LMR/SExpressions/SLocalBinding.Class.st | 41 + modules/LMR/SExpressions/SMessage.Class.st | 145 + modules/LMR/SExpressions/SMethod.Class.st | 58 + .../SNestedDynamicBinding.Class.st | 25 + modules/LMR/SExpressions/SNilBinding.Class.st | 30 + modules/LMR/SExpressions/SOpAssign.Class.st | 30 + .../SExpressions/SOpDispatchMessage.Class.st | 30 + modules/LMR/SExpressions/SOpDropToS.Class.st | 30 + modules/LMR/SExpressions/SOpJump.Class.st | 35 + .../LMR/SExpressions/SOpJumpFalse.Class.st | 20 + modules/LMR/SExpressions/SOpJumpTrue.Class.st | 20 + .../SExpressions/SOpLoadRfromFrame.Class.st | 30 + .../SExpressions/SOpLoadRfromStack.Class.st | 30 + .../LMR/SExpressions/SOpLoadRwithNil.Class.st | 20 + .../SExpressions/SOpLoadRwithSelf.Class.st | 20 + .../SExpressions/SOpNonLocalReturn.Class.st | 20 + modules/LMR/SExpressions/SOpPopR.Class.st | 20 + .../LMR/SExpressions/SOpPrimitive.Class.st | 30 + modules/LMR/SExpressions/SOpPushR.Class.st | 20 + modules/LMR/SExpressions/SOpRestart.Class.st | 20 + modules/LMR/SExpressions/SOpReturn.Class.st | 20 + .../SExpressions/SOpStoreRintoFrame.Class.st | 30 + modules/LMR/SExpressions/SOperation.Class.st | 15 + modules/LMR/SExpressions/SPragma.Class.st | 25 + modules/LMR/SExpressions/SReturn.Class.st | 57 + modules/LMR/SExpressions/SScript.Class.st | 72 + .../LMR/SExpressions/SSelfBinding.Class.st | 35 + .../LMR/SExpressions/SSuperBinding.Class.st | 30 + .../SExpressions/STemporaryBinding.Class.st | 49 + .../LMR/SExpressions/STrueBinding.Class.st | 30 + .../LMR/SExpressions/TreecodeDecoder.Class.st | 330 + modules/LMR/SendSite.Class.st | 557 ++ modules/LMR/StackChunk.Class.st | 91 + modules/LMR/StackFrameCursor.Class.st | 240 + modules/LMR/Thread.Class.st | 26 + .../CharacterArray.Extension.st | 28 + .../ModuleImporterModule.Class.st | 32 + modules/ModuleImporter/ModuleLoader.Class.st | 117 + .../ModuleImporter/ModuleSpecReader.Class.st | 155 + modules/NOS/Devices/Memory/Memory.Class.st | 71 + .../NOS/Devices/Memory/MemoryBlock.Class.st | 55 + .../Memory/MemoryManagerStrategy.Class.st | 45 + .../Network/InternalNetworkDevice.Class.st | 84 + .../LanceNICInitializationBlock16.Class.st | 296 + .../LanceNICReceiveRingDescriptor16.Class.st | 101 + .../Network/LanceNICRingDescriptor16.Class.st | 252 + .../LanceNICTransmitRingDescriptor16.Class.st | 264 + .../Devices/Network/LancePCIDevice.Class.st | 620 ++ modules/NOS/Devices/Network/Loopback.Class.st | 33 + .../Devices/Network/NetworkingDevice.Class.st | 49 + .../Network/PacketCapturerFile.Class.st | 73 + .../NOS/Devices/Network/PacketSocket.Class.st | 166 + .../Network/PacketSocketPlugin.Class.st | 54 + .../Network/Realtek8139PCIDevice.Class.st | 341 + modules/NOS/Devices/Network/SLIP.Class.st | 54 + modules/NOS/Devices/PC/CMOS.Class.st | 327 + modules/NOS/Devices/PC/OldPCKeyboard.Class.st | 721 +++ modules/NOS/Devices/PC/PCIBusEntry.Class.st | 1018 +++ modules/NOS/Devices/PC/PCIDevice.Class.st | 56 + modules/NOS/Devices/PC/PIC8259.Class.st | 167 + modules/NOS/Devices/PC/PS2Keyboard.Class.st | 923 +++ .../NOS/Devices/PC/ScancodeDecoder.Class.st | 95 + modules/NOS/Devices/PC/UART16550.Class.st | 97 + modules/NOS/Devices/PC/UART8250.Class.st | 377 ++ .../Devices/Processor/MicroProcessor.Class.st | 15 + .../Devices/Processor/X86Processor.Class.st | 64 + .../Devices/Storage/ATABenchmarker.Class.st | 173 + .../Devices/Storage/ATAController.Class.st | 973 +++ .../Storage/ATAControllerTest.Class.st | 83 + .../NOS/Devices/Storage/ATADevice.Class.st | 117 + .../Devices/Storage/ATARawController.Class.st | 105 + modules/NOS/Devices/Storage/ATATest.Class.st | 15 + .../NOS/Devices/Storage/BlockDevice.Class.st | 275 + .../Devices/Storage/BlockDeviceTest.Class.st | 122 + .../Devices/Storage/BlockDevicesTest.Class.st | 122 + .../IDEHardDiskDeviceInformation.Class.st | 305 + .../NOS/Devices/Storage/PCIBusMaster.Class.st | 135 + .../PhysicalRegionDescriptorTable.Class.st | 79 + modules/NOS/Devices/USB/SDDevice.Class.st | 483 ++ modules/NOS/Devices/USB/USBQueueHead.Class.st | 125 + .../USB/USBTransferDescriptor.Class.st | 318 + .../Devices/USB/USBUHCIController.Class.st | 844 +++ modules/NOS/External/Buffer.Class.st | 65 + .../NOS/External/DisplayInformation.Class.st | 86 + .../External/ElfSectionHeaderTable.Class.st | 73 + modules/NOS/External/KernelModule.Class.st | 73 + modules/NOS/External/MultiBootInfo.Class.st | 327 + .../NOS/External/MultiBootMemoryMap.Class.st | 41 + .../External/MultiBootMemoryMapEntry.Class.st | 73 + modules/NOS/External/ReadonlyPage.Class.st | 56 + modules/NOS/External/SnapshotInfo.Class.st | 87 + modules/NOS/External/SymbolTable.Class.st | 75 + modules/NOS/External/VMBridge.Class.st | 146 + modules/NOS/FileSupport/DeviceStream.Class.st | 73 + .../NOS/FileSupport/NopsysResolver.Class.st | 26 + .../ParagraphEditorWithBindings.Class.st | 29 + .../FileSupport/RemoteFileDirectory.Class.st | 63 + .../RemoteMultiByteFileStream.Class.st | 203 + .../FileSupport/RemoteObjectChannel.Class.st | 267 + .../NOS/FileSupport/RemoteWorkspace.Class.st | 33 + .../FAT32/ExampleFAT32FileSystemTest.Class.st | 235 + .../FAT32/FAT32BootRecord.Class.st | 285 + .../FileSystems/FAT32/FAT32Cluster.Class.st | 225 + .../FAT32/FAT32ClusterRecord.Class.st | 186 + .../FAT32/FAT32FileAllocationTable.Class.st | 225 + .../FAT32/FAT32FileSystem.Class.st | 544 ++ .../FAT32/FAT32FileSystemTest.Class.st | 69 + .../MultiByteFilesystemFileStream.Class.st | 155 + modules/NOS/FileSystems/NOSDirectory.Class.st | 62 + modules/NOS/FileSystems/NOSFile.Class.st | 259 + .../FileSystems/NOSFilesystemContent.Class.st | 94 + modules/NOS/Kernel/Computer.Class.st | 473 ++ modules/NOS/Kernel/ExternalIOPort.Class.st | 206 + modules/NOS/Kernel/HardwareDevice.Class.st | 165 + modules/NOS/Kernel/ImageSnapshotter.Class.st | 186 + .../InterruptRequestDispatcher.Class.st | 123 + .../MemoryManagerStrategy.Class.st | 45 + .../MemoryManager/PageFaultHandler.Class.st | 65 + .../NOS/MemoryManager/PageManager.Class.st | 250 + .../Paging/PageDirectory.Class.st | 86 + .../Paging/PageDirectoryRecord.Class.st | 22 + .../Paging/PageFaultParameters.Class.st | 25 + .../MemoryManager/Paging/PageIndex.Class.st | 127 + .../MemoryManager/Paging/PageTable.Class.st | 72 + .../Paging/PageTableEntry.Class.st | 146 + modules/NOS/MemoryManager/PagingTest.Class.st | 70 + modules/NOS/Network/Conduit/Conduit.Class.st | 146 + .../NOS/Network/Conduit/ConduitAlarm.Class.st | 60 + .../NOS/Network/Conduit/ConduitTimer.Class.st | 192 + .../Conduit/InternalRawSocket.Class.st | 80 + .../Network/Conduit/InternalSocket.Class.st | 158 + .../Exceptions/ConnectionRefused.Class.st | 45 + .../Exceptions/ConnectionReset.Class.st | 15 + .../NOS/Network/Exceptions/HostDown.Class.st | 30 + .../NOS/Network/Exceptions/NetDown.Class.st | 20 + .../Network/Exceptions/OutOfBandData.Class.st | 25 + .../Network/Interfaces/IPInterface.Class.st | 36 + .../Network/Interfaces/NetInterface.Class.st | 107 + modules/NOS/Network/Missing/Ping.Class.st | 15 + .../Network/Missing/TCPSynScanner.Class.st | 15 + .../NOS/Network/Missing/TraceRoute.Class.st | 15 + .../NOS/Network/Options/IP/IPOption.Class.st | 501 ++ .../Network/Options/IP/IPTimestamp.Class.st | 85 + modules/NOS/Network/Options/IP/LSRR.Class.st | 25 + .../Network/Options/IP/RecordRoute.Class.st | 48 + modules/NOS/Network/Options/IP/SSRR.Class.st | 25 + modules/NOS/Network/Options/TCP/MSS.Class.st | 40 + modules/NOS/Network/Options/TCP/SACK.Class.st | 63 + .../Network/Options/TCP/TCPOption.Class.st | 159 + .../Network/Options/TCP/TCPTimestamp.Class.st | 52 + .../Network/Options/TCP/WindowScale.Class.st | 50 + .../NOS/Network/Packets/EGPPacket.Class.st | 55 + .../NOS/Network/Packets/ICMPPacket.Class.st | 241 + .../NOS/Network/Packets/IGMPPacket.Class.st | 70 + .../NOS/Network/Packets/IGRPPacket.Class.st | 20 + modules/NOS/Network/Packets/IPPacket.Class.st | 2448 ++++++++ .../NOS/Network/Packets/IPv6Packet.Class.st | 20 + .../NOS/Network/Packets/IRTPPacket.Class.st | 100 + modules/NOS/Network/Packets/Packet.Class.st | 322 + .../NOS/Network/Packets/PacketOption.Class.st | 109 + .../NOS/Network/Packets/RARPPacket.Class.st | 47 + .../NOS/Network/Packets/RDPPacket.Class.st | 20 + .../NOS/Network/Packets/TCPPacket.Class.st | 5547 +++++++++++++++++ .../NOS/Network/Packets/UDPPacket.Class.st | 260 + .../Network/Packets/WirelessPacket.Class.st | 230 + .../Network/Protocols/Ethernet/ARP.Class.st | 167 + .../Protocols/Ethernet/ARPEntry.Class.st | 71 + .../Protocols/Ethernet/ARPPacket.Class.st | 195 + .../Protocols/Ethernet/ARPRequest.Class.st | 94 + .../Protocols/Ethernet/Ethernet.Class.st | 60 + .../Ethernet/EthernetAddress.Class.st | 71 + .../Ethernet/EthernetInterface.Class.st | 69 + .../Ethernet/EthernetPacket.Class.st | 79 + .../Network/Protocols/Ethernet/Route.Class.st | 52 + .../Protocols/Ethernet/RoutingTable.Class.st | 67 + .../NOS/Network/Protocols/IP/ICMP.Class.st | 49 + modules/NOS/Network/Protocols/IP/IP.Class.st | 103 + .../Network/Protocols/IP/IPChannel.Class.st | 109 + .../Protocols/IP/IPReassembler.Class.st | 54 + .../Protocols/IP/IPReassemblyList.Class.st | 93 + .../Protocols/TCP/InternalTCPSocket.Class.st | 408 ++ .../TCP/States/TCPCloseWait.Class.st | 35 + .../Protocols/TCP/States/TCPClosed.Class.st | 36 + .../Protocols/TCP/States/TCPClosing.Class.st | 31 + .../TCP/States/TCPEstablished.Class.st | 37 + .../Protocols/TCP/States/TCPFinWait1.Class.st | 40 + .../Protocols/TCP/States/TCPFinWait2.Class.st | 30 + .../Protocols/TCP/States/TCPIdle.Class.st | 15 + .../Protocols/TCP/States/TCPLastACK.Class.st | 34 + .../Protocols/TCP/States/TCPListen.Class.st | 44 + .../TCP/States/TCPOutputState.Class.st | 59 + .../Protocols/TCP/States/TCPPersist.Class.st | 34 + .../TCP/States/TCPRetransmit.Class.st | 20 + .../Protocols/TCP/States/TCPState.Class.st | 108 + .../TCP/States/TCPSynReceived.Class.st | 37 + .../Protocols/TCP/States/TCPSynSent.Class.st | 43 + .../Protocols/TCP/States/TCPTimeWait.Class.st | 29 + .../Protocols/TCP/States/TCPTransmit.Class.st | 25 + .../NOS/Network/Protocols/TCP/TCP.Class.st | 76 + .../Network/Protocols/TCP/TCPChannel.Class.st | 40 + .../Protocols/TCP/TCPReassembler.Class.st | 158 + .../Protocols/UDP/InternalUDPSocket.Class.st | 80 + .../NOS/Network/Protocols/UDP/UDP.Class.st | 72 + .../Network/Protocols/UDP/UDPChannel.Class.st | 27 + modules/NOS/Network/Support/BitArray.Class.st | 124 + .../Network/Support/CircularBuffer.Class.st | 89 + .../Network/Support/InternetAddress.Class.st | 107 + .../NOS/Network/Support/NetAddress.Class.st | 99 + modules/NOS/Network/Support/NetBlock.Class.st | 73 + .../NOS/Network/Support/NetStream.Class.st | 31 + .../Support/TCPSequenceNumber.Class.st | 65 + .../Network/Tests/IPFragmentsTest.Class.st | 65 + .../NOS/Network/Tests/IPOptionsTest.Class.st | 42 + modules/NOS/Network/Tests/IPTest.Class.st | 131 + .../Network/Tests/NetHighLevelTest.Class.st | 91 + .../Network/Tests/PacketInspector.Class.st | 44 + .../Network/Tests/PluggableConduit.Class.st | 45 + .../Network/Tests/RealisticLoopback.Class.st | 102 + .../Tests/SqueakNOSNetworkTest.Class.st | 127 + .../NOS/Network/Tests/TCPPacketTest.Class.st | 33 + .../Network/Tests/TCPReassemblerTest.Class.st | 118 + .../Network/Tests/TCPSequenceTest.Class.st | 43 + modules/NOS/Network/Tests/TCPTest.Class.st | 286 + modules/NOS/OFW-OLPC/OFWDeviceNode.Class.st | 82 + .../OpenFirmwareCalloutClient.Class.st | 59 + modules/NOS/Storage/BlockArithmetic.Class.st | 89 + modules/NOS/Storage/BlockArithmetic0.Class.st | 40 + modules/NOS/Storage/BlockCache.Class.st | 191 + modules/NOS/Storage/BlockCacheTest.Class.st | 60 + .../NOS/Storage/BlockDeviceOnStream.Class.st | 73 + .../NOS/Storage/BlockDeviceSegment.Class.st | 79 + .../Storage/ByteArrayOnBlockDevice.Class.st | 121 + .../NOS/Storage/ByteArrayOnStream.Class.st | 79 + modules/NOS/Storage/ByteArraySegment.Class.st | 213 + .../NOS/Storage/CheapHardDiskStream.Class.st | 116 + .../NOS/Storage/DualTestBlockDevice.Class.st | 69 + modules/NOS/Storage/MasterBootRecord.Class.st | 63 + .../NOS/Storage/MemoryBlockDevice.Class.st | 49 + modules/NOS/Storage/NullBlockCache.Class.st | 94 + modules/NOS/Storage/PartitionRecord.Class.st | 142 + modules/NOS/Storage/ReadBlockCache.Class.st | 91 + modules/NOS/Storage/Segment.Class.st | 22 + modules/NOS/Storage/StreamOnStream.Class.st | 86 + .../Tests/BlockArithmeticTest.Class.st | 49 + .../NOS/Storage/Tests/BlockCacheTest.Class.st | 60 + .../Tests/MemoryBlockDeviceTest.Class.st | 15 + .../Storage/Tests/StreamOnStreamTest.Class.st | 87 + .../NOS/Storage/Tests/WriteListTest.Class.st | 42 + modules/NOS/Storage/WriteList.Class.st | 134 + .../Extensions/Character.Extension.st | 27 + .../Extensions/CharacterArray.Extension.st | 15 + .../Extensions/Closure.Extension.st | 9 + .../Extensions/ExtensionsModule.Class.st | 30 + .../Extensions/Object.Extension.st | 19 + .../Extensions/ReadStream.Extension.st | 9 + .../SequenceableCollection.Extension.st | 19 + .../PetitParser/Extensions/Set.Extension.st | 9 + .../Extensions/Symbol.Extension.st | 9 + .../Extensions/UndefinedObject.Extension.st | 9 + modules/PetitParser/PPFailure.Class.st | 65 + modules/PetitParser/PPMemento.Class.st | 60 + modules/PetitParser/PPStream.Class.st | 78 + modules/PetitParser/PPToken.Class.st | 140 + .../Parsers/PPActionParser.Class.st | 54 + .../PetitParser/Parsers/PPAndParser.Class.st | 42 + .../Parsers/PPCharSetPredicate.Class.st | 47 + .../Parsers/PPChoiceParser.Class.st | 43 + .../Parsers/PPDelegateParser.Class.st | 42 + .../Parsers/PPEndOfInputParser.Class.st | 38 + .../Parsers/PPEpsilonParser.Class.st | 35 + .../Parsers/PPFailingParser.Class.st | 50 + .../Parsers/PPFlattenParser.Class.st | 45 + .../PetitParser/Parsers/PPListParser.Class.st | 66 + .../Parsers/PPLiteralObjectParser.Class.st | 37 + .../Parsers/PPLiteralParser.Class.st | 78 + .../Parsers/PPLiteralSequenceParser.Class.st | 53 + .../Parsers/PPMappedParser.Class.st | 56 + .../Parsers/PPMemoizedParser.Class.st | 60 + .../PetitParser/Parsers/PPNotParser.Class.st | 37 + .../Parsers/PPOptionalParser.Class.st | 35 + modules/PetitParser/Parsers/PPParser.Class.st | 556 ++ .../Parsers/PPPluggableParser.Class.st | 49 + .../Parsers/PPPredicateObjectParser.Class.st | 272 + .../Parsers/PPPredicateParser.Class.st | 42 + .../PPPredicateSequenceParser.Class.st | 78 + .../Parsers/PPRepeatingParser.Class.st | 123 + .../Parsers/PPSequenceParser.Class.st | 66 + .../Parsers/PPSequencedChoiceParser.Class.st | 51 + .../Parsers/PPTokenParser.Class.st | 56 + .../Parsers/PPTrimmingParser.Class.st | 63 + .../Parsers/PPWrappingParser.Class.st | 36 + .../PetitParser/PetitParserModule.Class.st | 22 + .../Tools/PPCompositeParser.Class.st | 122 + .../Tools/PPExpressionParser.Class.st | 131 + .../Tools/PPUnresolvedParser.Class.st | 32 + .../PetitParser/Tools/ToolsModule.Class.st | 30 + modules/Random/Random.Class.st | 150 + modules/Random/RandomModule.Class.st | 33 + modules/Random/Tests/RandomTest.Class.st | 164 + modules/Random/Tests/TestsModule.Class.st | 46 + modules/STON/Association.Extension.st | 9 + modules/STON/Boolean.Extension.st | 9 + modules/STON/ByteArray class.Extension.st | 35 + modules/STON/Character class.Extension.st | 14 + modules/STON/Class class.Extension.st | 14 + modules/STON/Closure.Extension.st | 11 + modules/STON/Collection class.Extension.st | 20 + modules/STON/Date class.Extension.st | 14 + modules/STON/Dictionary class.Extension.st | 22 + modules/STON/HashedCollection.Extension.st | 9 + modules/STON/Integer.Extension.st | 9 + modules/STON/Interval class.Extension.st | 19 + modules/STON/Metaclass class.Extension.st | 21 + modules/STON/Number.Extension.st | 9 + modules/STON/Object class.Extension.st | 51 + modules/STON/OrderedDictionary.Extension.st | 9 + modules/STON/Point.Extension.st | 18 + modules/STON/STON.Class.st | 109 + modules/STON/STONJSON.Class.st | 51 + modules/STON/STONMapWriter.Class.st | 26 + modules/STON/STONModule.Class.st | 36 + modules/STON/STONReader.Class.st | 522 ++ modules/STON/STONReaderError.Class.st | 55 + modules/STON/STONReference.Class.st | 57 + modules/STON/STONStreamWriter.Class.st | 56 + modules/STON/STONWriter.Class.st | 367 ++ modules/STON/STONWriterError.Class.st | 21 + .../SequenceableCollection class.Extension.st | 26 + modules/STON/String.Extension.st | 9 + modules/STON/Symbol.Extension.st | 9 + modules/STON/Time class.Extension.st | 43 + modules/STON/Timestamp class.Extension.st | 27 + modules/STON/UndefinedObject.Extension.st | 9 + modules/SUnit/CharacterArray.Extension.st | 19 + modules/SUnit/Class.Extension.st | 9 + modules/SUnit/Closure.Extension.st | 33 + modules/SUnit/CompiledExpression.Extension.st | 9 + modules/SUnit/CompiledMethod.Extension.st | 9 + modules/SUnit/Exception.Extension.st | 21 + modules/SUnit/ExceptionHandler.Extension.st | 9 + modules/SUnit/Object.Extension.st | 19 + modules/SUnit/SUnitModule.Class.st | 35 + modules/SUnit/SUnitNameResolver.Class.st | 48 + modules/SUnit/Species.Extension.st | 44 + modules/SUnit/Symbol.Extension.st | 9 + modules/SUnit/TestCase.Class.st | 788 +++ modules/SUnit/TestCounter.Class.st | 74 + modules/SUnit/TestFailure.Class.st | 36 + modules/SUnit/TestResource.Class.st | 142 + modules/SUnit/TestResult.Class.st | 381 ++ modules/SUnit/TestSkipped.Class.st | 26 + modules/SUnit/TestSuite.Class.st | 309 + modules/SUnit/Tests/ExampleSetTest.Class.st | 70 + .../ResumableTestFailureTestCase.Class.st | 77 + modules/SUnit/Tests/SUnitTest.Class.st | 306 + .../SUnit/Tests/SimpleTestResource.Class.st | 71 + .../Tests/SimpleTestResourceTestCase.Class.st | 79 + modules/SUnit/Tests/TestsModule.Class.st | 41 + modules/TOML/TOMLModule.Class.st | 28 + modules/TOML/TOMLParser.Class.st | 663 ++ modules/TOML/TOMLWriter.Class.st | 185 + modules/TOML/Tests/TOMLParserTest.Class.st | 360 ++ modules/TOML/Tests/TestsModule.Class.st | 46 + .../TinyBenchmarksModule.Class.st | 102 + modules/Tonel/Loader/LoaderModule.Class.st | 34 + modules/Tonel/Loader/TonelLoader.Class.st | 163 + modules/Tonel/Module.Extension.st | 34 + modules/Tonel/ReadStream.Extension.st | 25 + modules/Tonel/Tests/TestsModule.Class.st | 41 + modules/Tonel/Tests/TonelWriterTest.Class.st | 203 + modules/Tonel/TonelModule.Class.st | 24 + modules/Tonel/TonelReader.Class.st | 150 + modules/Tonel/TonelWriter.Class.st | 246 + modules/Webside/ByteArray.Extension.st | 23 + modules/Webside/Class.Extension.st | 28 + modules/Webside/CompiledMethod.Extension.st | 29 + modules/Webside/Metaclass.Extension.st | 12 + modules/Webside/Object.Extension.st | 26 + modules/Webside/Species.Extension.st | 22 + modules/Webside/WebsideAPI.Class.st | 501 ++ modules/Webside/WebsideApplication.Class.st | 108 + modules/Webside/WebsideModule.Class.st | 45 + 893 files changed, 130633 insertions(+) create mode 100644 modules/ArgParser/ArgParser.Class.st create mode 100644 modules/ArgParser/ArgParserModule.Class.st create mode 100644 modules/ArgParser/Command.Class.st create mode 100644 modules/ArgParser/Option.Class.st create mode 100644 modules/ArgParser/ParseResult.Class.st create mode 100644 modules/CodeSpecs/ClassSpec.Class.st create mode 100644 modules/CodeSpecs/CodeSpecsModule.Class.st create mode 100644 modules/CodeSpecs/MetaclassSpec.Class.st create mode 100644 modules/CodeSpecs/MethodSpec.Class.st create mode 100644 modules/CodeSpecs/ModuleSpec.Class.st create mode 100644 modules/CodeSpecs/SpeciesSpec.Class.st create mode 100644 modules/Compiler/ArgumentBinding.Class.st create mode 100644 modules/Compiler/ArgumentEnvironment.Class.st create mode 100644 modules/Compiler/ArrayEnvironment.Class.st create mode 100644 modules/Compiler/Binding.Class.st create mode 100644 modules/Compiler/BlockScope.Class.st create mode 100644 modules/Compiler/CompilerModule.Class.st create mode 100644 modules/Compiler/DynamicBinding.Class.st create mode 100644 modules/Compiler/FalseBinding.Class.st create mode 100644 modules/Compiler/IdentifierBinder.Class.st create mode 100644 modules/Compiler/InlinedArgEnvironment.Class.st create mode 100644 modules/Compiler/LiteralBinding.Class.st create mode 100644 modules/Compiler/LocalBinding.Class.st create mode 100644 modules/Compiler/LocalEnvironment.Class.st create mode 100644 modules/Compiler/MessageInliner.Class.st create mode 100644 modules/Compiler/MethodScope.Class.st create mode 100644 modules/Compiler/NestedDynamicBinding.Class.st create mode 100644 modules/Compiler/NilBinding.Class.st create mode 100644 modules/Compiler/SAssignmentNode.Class.st create mode 100644 modules/Compiler/SBlockNode.Class.st create mode 100644 modules/Compiler/SBraceNode.Class.st create mode 100644 modules/Compiler/SCascadeMessageNode.Class.st create mode 100644 modules/Compiler/SCascadeNode.Class.st create mode 100644 modules/Compiler/SCommentNode.Class.st create mode 100644 modules/Compiler/SCompilationError.Class.st create mode 100644 modules/Compiler/SCompilationResult.Class.st create mode 100644 modules/Compiler/SCompiler.Class.st create mode 100644 modules/Compiler/SDelimiterToken.Class.st create mode 100644 modules/Compiler/SEndToken.Class.st create mode 100644 modules/Compiler/SFFIDescriptor.Class.st create mode 100644 modules/Compiler/SIdentifierNode.Class.st create mode 100644 modules/Compiler/SInvalidPragmaError.Class.st create mode 100644 modules/Compiler/SLiteralNode.Class.st create mode 100644 modules/Compiler/SMessageNode.Class.st create mode 100644 modules/Compiler/SMethodNode.Class.st create mode 100644 modules/Compiler/SNumberNode.Class.st create mode 100644 modules/Compiler/SParseNode.Class.st create mode 100644 modules/Compiler/SParseTreeVisitor.Class.st create mode 100644 modules/Compiler/SPragmaNode.Class.st create mode 100644 modules/Compiler/SReturnNode.Class.st create mode 100644 modules/Compiler/SScriptNode.Class.st create mode 100644 modules/Compiler/SSelectorNode.Class.st create mode 100644 modules/Compiler/SSemanticVisitor.Class.st create mode 100644 modules/Compiler/SSmalltalkCompiler.Class.st create mode 100644 modules/Compiler/SSmalltalkParser.Class.st create mode 100644 modules/Compiler/SSmalltalkScanner.Class.st create mode 100644 modules/Compiler/SStringNode.Class.st create mode 100644 modules/Compiler/SStringToken.Class.st create mode 100644 modules/Compiler/SSymbolicToken.Class.st create mode 100644 modules/Compiler/SToken.Class.st create mode 100644 modules/Compiler/SUndeclaredIdentifierError.Class.st create mode 100644 modules/Compiler/ScriptScope.Class.st create mode 100644 modules/Compiler/SelfBinding.Class.st create mode 100644 modules/Compiler/Species.Extension.st create mode 100644 modules/Compiler/StackEnvironment.Class.st create mode 100644 modules/Compiler/StaticBinder.Class.st create mode 100644 modules/Compiler/SuperBinding.Class.st create mode 100644 modules/Compiler/TemporaryBinding.Class.st create mode 100644 modules/Compiler/Tests/MessageInlinerTest.Class.st create mode 100644 modules/Compiler/Tests/SmalltalkScannerTest.Class.st create mode 100644 modules/Compiler/Tests/TestsModule.Class.st create mode 100644 modules/Compiler/TreecodeEncoder.Class.st create mode 100644 modules/Compiler/TrueBinding.Class.st create mode 100644 modules/Development/BeginningCondition.Class.st create mode 100644 modules/Development/ClassSearch.Class.st create mode 100644 modules/Development/CodeSearch.Class.st create mode 100644 modules/Development/CodeSearchCondition.Class.st create mode 100644 modules/Development/CodeSearchResult.Class.st create mode 100644 modules/Development/CompiledMethod.Extension.st create mode 100644 modules/Development/DevelopmentModule.Class.st create mode 100644 modules/Development/EndingCondition.Class.st create mode 100644 modules/Development/ExactMatchCondition.Class.st create mode 100644 modules/Development/IncludingCondition.Class.st create mode 100644 modules/Development/MethodSearch.Class.st create mode 100644 modules/Development/MethodSearchScope.Class.st create mode 100644 modules/Development/PatternCondition.Class.st create mode 100644 modules/Development/SimilarityCondition.Class.st create mode 100644 modules/EPM/Config.Class.st create mode 100644 modules/EPM/EPMModule.Class.st create mode 100644 modules/EPM/ProjectGenerator.Class.st create mode 100644 modules/Examples/HTTPServer/ExampleAPI.Class.st create mode 100644 modules/Examples/HTTPServer/HTTPServerModule.Class.st create mode 100644 modules/Examples/HelloWorld/HelloWorldModule.Class.st create mode 100644 modules/Examples/PrintClasses/PrintClassesModule.Class.st create mode 100644 modules/FFI/ByteArray.Extension.st create mode 100644 modules/FFI/ByteArraySegment.Extension.st create mode 100644 modules/FFI/CallbackBehavior.Class.st create mode 100644 modules/FFI/CallbackMethod.Class.st create mode 100644 modules/FFI/CharacterArray.Extension.st create mode 100644 modules/FFI/ExternalHandle.Class.st create mode 100644 modules/FFI/ExternalHeap.Class.st create mode 100644 modules/FFI/ExternalLibrary.Class.st create mode 100644 modules/FFI/ExternalMemory.Class.st create mode 100644 modules/FFI/ExternalObject.Class.st create mode 100644 modules/FFI/FFIDescriptor.Class.st create mode 100644 modules/FFI/FFIMethod.Class.st create mode 100644 modules/FFI/FFIModule.Class.st create mode 100644 modules/FFI/Float.Extension.st create mode 100644 modules/FFI/Integer.Extension.st create mode 100644 modules/FFI/LibC.Class.st create mode 100644 modules/FFI/LibraryLoader.Class.st create mode 100644 modules/FFI/MallocHeap.Class.st create mode 100644 modules/FFI/Object.Extension.st create mode 100644 modules/FFI/Posix/DLLibrary.Class.st create mode 100644 modules/FFI/Posix/PosixLibraryLoader.Class.st create mode 100644 modules/FFI/Posix/PosixModule.Class.st create mode 100644 modules/FFI/String.Extension.st create mode 100644 modules/FFI/Tests/TestLibrary.Class.st create mode 100644 modules/FFI/Tests/TestsModule.Class.st create mode 100644 modules/FFI/Windows/KernelDLL.Class.st create mode 100644 modules/FFI/Windows/WindowsLibraryLoader.Class.st create mode 100644 modules/FFI/Windows/WindowsModule.Class.st create mode 100644 modules/Filesystem/Directory.Class.st create mode 100644 modules/Filesystem/File.Class.st create mode 100644 modules/Filesystem/FilesystemEntry.Class.st create mode 100644 modules/Filesystem/FilesystemModule.Class.st create mode 100644 modules/Filesystem/Native/CPPFilesystemLibrary.Class.st create mode 100644 modules/Filesystem/Native/NativeFSModule.Class.st create mode 100644 modules/Filesystem/Node/NodeFSModule.Class.st create mode 100644 modules/Filesystem/Node/NodeFilesystemLibrary.Class.st create mode 100644 modules/Filesystem/Path.Class.st create mode 100644 modules/Filesystem/String.Extension.st create mode 100644 modules/HTTP/CPPHTTPServer/CPPHTTPServerModule.Class.st create mode 100644 modules/HTTP/CPPHTTPServer/HTTPMessage.Class.st create mode 100644 modules/HTTP/CPPHTTPServer/HTTPObject.Class.st create mode 100644 modules/HTTP/CPPHTTPServer/HTTPRequest.Class.st create mode 100644 modules/HTTP/CPPHTTPServer/HTTPResponse.Class.st create mode 100644 modules/HTTP/CPPHTTPServer/HTTPServer.Class.st create mode 100644 modules/HTTP/CPPHTTPServer/HTTPServerLibrary.Class.st create mode 100644 modules/ImageSegmentBuilder/Behavior.Extension.st create mode 100644 modules/ImageSegmentBuilder/Boolean.Extension.st create mode 100644 modules/ImageSegmentBuilder/Builder.Class.st create mode 100644 modules/ImageSegmentBuilder/Character.Extension.st create mode 100644 modules/ImageSegmentBuilder/Class.Extension.st create mode 100644 modules/ImageSegmentBuilder/False.Extension.st create mode 100644 modules/ImageSegmentBuilder/ImageSegmentBuilderModule.Class.st create mode 100644 modules/ImageSegmentBuilder/JSON/JSONModule.Class.st create mode 100644 modules/ImageSegmentBuilder/JSON/JSONWriter.Class.st create mode 100644 modules/ImageSegmentBuilder/Metaclass.Extension.st create mode 100644 modules/ImageSegmentBuilder/Module.Extension.st create mode 100644 modules/ImageSegmentBuilder/Native/NativeModule.Class.st create mode 100644 modules/ImageSegmentBuilder/Native/NativeWriter.Class.st create mode 100644 modules/ImageSegmentBuilder/Object.Extension.st create mode 100644 modules/ImageSegmentBuilder/ObjectClosure.Class.st create mode 100644 modules/ImageSegmentBuilder/Symbol.Extension.st create mode 100644 modules/ImageSegmentBuilder/True.Extension.st create mode 100644 modules/ImageSegmentBuilder/UndefinedObject.Extension.st create mode 100644 modules/ImageSegmentBuilder/Writer.Class.st create mode 100644 modules/JSON/BooleanAdaptor.Class.st create mode 100644 modules/JSON/DataAdaptor.Class.st create mode 100644 modules/JSON/IdAdaptor.Class.st create mode 100644 modules/JSON/JsonAnySchema.Class.st create mode 100644 modules/JSON/JsonArraySchema.Class.st create mode 100644 modules/JSON/JsonBooleanSchema.Class.st create mode 100644 modules/JSON/JsonCombinedSchema.Class.st create mode 100644 modules/JSON/JsonDateFormat.Class.st create mode 100644 modules/JSON/JsonDateTimeFormat.Class.st create mode 100644 modules/JSON/JsonEmailFormat.Class.st create mode 100644 modules/JSON/JsonError.Class.st create mode 100644 modules/JSON/JsonFormat.Class.st create mode 100644 modules/JSON/JsonImporter.Class.st create mode 100644 modules/JSON/JsonImporterError.Class.st create mode 100644 modules/JSON/JsonIntegerFormat.Class.st create mode 100644 modules/JSON/JsonIntegerSchema.Class.st create mode 100644 modules/JSON/JsonMapping.Class.st create mode 100644 modules/JSON/JsonMappingRegistry.Class.st create mode 100644 modules/JSON/JsonModule.Class.st create mode 100644 modules/JSON/JsonNotSchema.Class.st create mode 100644 modules/JSON/JsonNullSchema.Class.st create mode 100644 modules/JSON/JsonNumberFormat.Class.st create mode 100644 modules/JSON/JsonNumberSchema.Class.st create mode 100644 modules/JSON/JsonObject.Class.st create mode 100644 modules/JSON/JsonObjectSchema.Class.st create mode 100644 modules/JSON/JsonOneSchema.Class.st create mode 100644 modules/JSON/JsonPainter.Class.st create mode 100644 modules/JSON/JsonParser.Class.st create mode 100644 modules/JSON/JsonPrimitiveSchema.Class.st create mode 100644 modules/JSON/JsonPropertyMap.Class.st create mode 100644 modules/JSON/JsonSchema.Class.st create mode 100644 modules/JSON/JsonSchemaReference.Class.st create mode 100644 modules/JSON/JsonSerializer.Class.st create mode 100644 modules/JSON/JsonStringFormat.Class.st create mode 100644 modules/JSON/JsonStringSchema.Class.st create mode 100644 modules/JSON/JsonUriFormat.Class.st create mode 100644 modules/JSON/JsonWriter.Class.st create mode 100644 modules/JSON/Object.Extension.st create mode 100644 modules/JSON/StringAdaptor.Class.st create mode 100644 modules/JSON/SymbolAdaptor.Class.st create mode 100644 modules/JSON/Tests/JsonMappingTest.Class.st create mode 100644 modules/JSON/Tests/JsonParserTest.Class.st create mode 100644 modules/JSON/Tests/JsonSchemaTest.Class.st create mode 100644 modules/JSON/Tests/JsonSerializationTest.Class.st create mode 100644 modules/JSON/Tests/JsonWriterTest.Class.st create mode 100644 modules/JSON/TimestampAdaptor.Class.st create mode 100644 modules/JSON/TypeAdaptor.Class.st create mode 100644 modules/Kernel/Abort.Class.st create mode 100644 modules/Kernel/ActionSequence.Class.st create mode 100644 modules/Kernel/ActiveProcess.Class.st create mode 100644 modules/Kernel/Ansi.Class.st create mode 100644 modules/Kernel/ArithmeticError.Class.st create mode 100644 modules/Kernel/Array.Class.st create mode 100644 modules/Kernel/ArrayedCollection.Class.st create mode 100644 modules/Kernel/AssertionFailure.Class.st create mode 100644 modules/Kernel/Association.Class.st create mode 100644 modules/Kernel/Bag.Class.st create mode 100644 modules/Kernel/BareTests/BareTestsModule.Class.st create mode 100644 modules/Kernel/BeeTranscript.Class.st create mode 100644 modules/Kernel/Behavior.Class.st create mode 100644 modules/Kernel/Boolean.Class.st create mode 100644 modules/Kernel/BootstrapDictionary.Class.st create mode 100644 modules/Kernel/ByteArray.Class.st create mode 100644 modules/Kernel/ByteArraySegment.Class.st create mode 100644 modules/Kernel/Character.Class.st create mode 100644 modules/Kernel/CharacterArray.Class.st create mode 100644 modules/Kernel/Class.Class.st create mode 100644 modules/Kernel/ClassOrganizer.Class.st create mode 100644 modules/Kernel/Closure.Class.st create mode 100644 modules/Kernel/Collection.Class.st create mode 100644 modules/Kernel/CommandLine.Class.st create mode 100644 modules/Kernel/CompiledBlock.Class.st create mode 100644 modules/Kernel/CompiledExpression.Class.st create mode 100644 modules/Kernel/CompiledMethod.Class.st create mode 100644 modules/Kernel/CompositeCollection.Class.st create mode 100644 modules/Kernel/Context.Class.st create mode 100644 modules/Kernel/Date.Class.st create mode 100644 modules/Kernel/Delay.Class.st create mode 100644 modules/Kernel/DeletedClass.Class.st create mode 100644 modules/Kernel/Dictionary.Class.st create mode 100644 modules/Kernel/EndOfStream.Class.st create mode 100644 modules/Kernel/Ephemeron.Class.st create mode 100644 modules/Kernel/Error.Class.st create mode 100644 modules/Kernel/EventHandlerMessage.Class.st create mode 100644 modules/Kernel/Exception.Class.st create mode 100644 modules/Kernel/ExceptionHandler.Class.st create mode 100644 modules/Kernel/ExceptionSet.Class.st create mode 100644 modules/Kernel/False.Class.st create mode 100644 modules/Kernel/Float.Class.st create mode 100644 modules/Kernel/FloatUnderflow.Class.st create mode 100644 modules/Kernel/Fraction.Class.st create mode 100644 modules/Kernel/Halt.Class.st create mode 100644 modules/Kernel/HashTable.Class.st create mode 100644 modules/Kernel/HashTablePolicy.Class.st create mode 100644 modules/Kernel/HashedCollection.Class.st create mode 100644 modules/Kernel/HostSystem.Class.st create mode 100644 modules/Kernel/IdentityDictionary.Class.st create mode 100644 modules/Kernel/IdentitySet.Class.st create mode 100644 modules/Kernel/ImageSegment.Class.st create mode 100644 modules/Kernel/InlinedDictionary.Class.st create mode 100644 modules/Kernel/InlinedHashTable.Class.st create mode 100644 modules/Kernel/Integer.Class.st create mode 100644 modules/Kernel/InternalReadStream.Class.st create mode 100644 modules/Kernel/InternalWriteStream.Class.st create mode 100644 modules/Kernel/Interval.Class.st create mode 100644 modules/Kernel/KernelModule.Class.st create mode 100644 modules/Kernel/KeyNotFound.Class.st create mode 100644 modules/Kernel/LMR/LMRArrayedCollection.Class.st create mode 100644 modules/Kernel/LMR/LMRCharacterArray.Class.st create mode 100644 modules/Kernel/LMR/LMRClosure.Class.st create mode 100644 modules/Kernel/LMR/LMRFloat.Class.st create mode 100644 modules/Kernel/LMR/LMRModule.Class.st create mode 100644 modules/Kernel/LMR/LMRObject.Class.st create mode 100644 modules/Kernel/LMR/LMRProtoObject.Class.st create mode 100644 modules/Kernel/LMR/LMRSmallInteger.Class.st create mode 100644 modules/Kernel/LMR/LMRSpecies.Class.st create mode 100644 modules/Kernel/LMR/LMRSymbol.Class.st create mode 100644 modules/Kernel/LargeInteger.Class.st create mode 100644 modules/Kernel/LargeNegativeInteger.Class.st create mode 100644 modules/Kernel/LargePositiveInteger.Class.st create mode 100644 modules/Kernel/LaunchContext.Class.st create mode 100644 modules/Kernel/LinkedCollection.Class.st create mode 100644 modules/Kernel/Locale.Class.st create mode 100644 modules/Kernel/Magnitude.Class.st create mode 100644 modules/Kernel/MatchAlgorithm.Class.st create mode 100644 modules/Kernel/MatchToken.Class.st create mode 100644 modules/Kernel/Message.Class.st create mode 100644 modules/Kernel/MessageNotUnderstood.Class.st create mode 100644 modules/Kernel/MessageSend.Class.st create mode 100644 modules/Kernel/Metaclass.Class.st create mode 100644 modules/Kernel/MethodDictionary.Class.st create mode 100644 modules/Kernel/Module.Class.st create mode 100644 modules/Kernel/Namespace.Class.st create mode 100644 modules/Kernel/Notification.Class.st create mode 100644 modules/Kernel/Number.Class.st create mode 100644 modules/Kernel/NumberParser.Class.st create mode 100644 modules/Kernel/Object.Class.st create mode 100644 modules/Kernel/ObjectReference.Class.st create mode 100644 modules/Kernel/OpenHashTable.Class.st create mode 100644 modules/Kernel/OrderedCollection.Class.st create mode 100644 modules/Kernel/OrderedDictionary.Class.st create mode 100644 modules/Kernel/OrderedHashTable.Class.st create mode 100644 modules/Kernel/Point.Class.st create mode 100644 modules/Kernel/Process.Class.st create mode 100644 modules/Kernel/ProcessStack.Class.st create mode 100644 modules/Kernel/ProcessStackChunk.Class.st create mode 100644 modules/Kernel/ProcessVMStack.Class.st create mode 100644 modules/Kernel/ProcessorScheduler.Class.st create mode 100644 modules/Kernel/ProtoObject.Class.st create mode 100644 modules/Kernel/ReadStream.Class.st create mode 100644 modules/Kernel/ReadWriteStream.Class.st create mode 100644 modules/Kernel/Rectangle.Class.st create mode 100644 modules/Kernel/Recursion.Class.st create mode 100644 modules/Kernel/ScaledDecimal.Class.st create mode 100644 modules/Kernel/Semaphore.Class.st create mode 100644 modules/Kernel/SequenceableCollection.Class.st create mode 100644 modules/Kernel/Set.Class.st create mode 100644 modules/Kernel/SmallInteger.Class.st create mode 100644 modules/Kernel/SmalltalkSession.Class.st create mode 100644 modules/Kernel/SmalltalkSystem.Class.st create mode 100644 modules/Kernel/SortedCollection.Class.st create mode 100644 modules/Kernel/Species.Class.st create mode 100644 modules/Kernel/StackOverflow.Class.st create mode 100644 modules/Kernel/StarToken.Class.st create mode 100644 modules/Kernel/Stream.Class.st create mode 100644 modules/Kernel/Stretch.Class.st create mode 100644 modules/Kernel/String.Class.st create mode 100644 modules/Kernel/StringPattern.Class.st create mode 100644 modules/Kernel/SuspendedProcess.Class.st create mode 100644 modules/Kernel/Symbol.Class.st create mode 100644 modules/Kernel/SymbolicReference.Class.st create mode 100644 modules/Kernel/Time.Class.st create mode 100644 modules/Kernel/Timer.Class.st create mode 100644 modules/Kernel/Timestamp.Class.st create mode 100644 modules/Kernel/True.Class.st create mode 100644 modules/Kernel/UTF16.Class.st create mode 100644 modules/Kernel/UTF32.Class.st create mode 100644 modules/Kernel/UTF8.Class.st create mode 100644 modules/Kernel/UndefinedObject.Class.st create mode 100644 modules/Kernel/Unicode.Class.st create mode 100644 modules/Kernel/VM/Closure.Extension.st create mode 100644 modules/Kernel/VM/CompiledMethod.Extension.st create mode 100644 modules/Kernel/VM/Float.Extension.st create mode 100644 modules/Kernel/VM/HashTable.Extension.st create mode 100644 modules/Kernel/VM/Namespace.Extension.st create mode 100644 modules/Kernel/VM/ProcessStack.Extension.st create mode 100644 modules/Kernel/VM/ProtoObject.Extension.st create mode 100644 modules/Kernel/VM/SmallInteger.Extension.st create mode 100644 modules/Kernel/VM/Species.Extension.st create mode 100644 modules/Kernel/VM/String.Extension.st create mode 100644 modules/Kernel/VM/Symbol.Extension.st create mode 100644 modules/Kernel/Warning.Class.st create mode 100644 modules/Kernel/WeakArray.Class.st create mode 100644 modules/Kernel/WeakIdentityDictionary.Class.st create mode 100644 modules/Kernel/WeakIdentitySet.Class.st create mode 100644 modules/Kernel/WideString.Class.st create mode 100644 modules/Kernel/WideSymbol.Class.st create mode 100644 modules/Kernel/WriteStream.Class.st create mode 100644 modules/Kernel/WriteStringStream.Class.st create mode 100644 modules/Kernel/ZeroDivide.Class.st create mode 100644 modules/LMR/AllocationZone.Class.st create mode 100644 modules/LMR/Allocator.Class.st create mode 100644 modules/LMR/CopyingCollector.Class.st create mode 100644 modules/LMR/CriticalArray.Class.st create mode 100644 modules/LMR/CriticalStack.Class.st create mode 100644 modules/LMR/DispatchSite.Class.st create mode 100644 modules/LMR/EdenCollector.Class.st create mode 100644 modules/LMR/GCSpace.Class.st create mode 100644 modules/LMR/GarbageCollector.Class.st create mode 100644 modules/LMR/GarbageFirstCollector.Class.st create mode 100644 modules/LMR/GenGCPass.Class.st create mode 100644 modules/LMR/GlobalDispatchCache.Class.st create mode 100644 modules/LMR/LMRModule.Class.st create mode 100644 modules/LMR/Memory.Class.st create mode 100644 modules/LMR/MemoryMeter.Class.st create mode 100644 modules/LMR/NativeCode.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/ABI.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Assembler.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/CodeGenerator.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/GenericAssembler.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/AMD64CodeGenerator.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/AMD64TemplateAssembler.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/ISAImmediate.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/ISAInstruction.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/ISAOperand.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/ISAOperandType.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/InstructionEncoder.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/InstructionPrefix.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/InstructionSpec.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/IntelModule.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/LegacyPrefix.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/MemoryOperand.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/OperandEncoding.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Parser/AssemblerGrammar.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Parser/AssemblerParser.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Parser/Assembly.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/REXPrefix.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Register.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/SegmentPrefix.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/SysVX64ABI.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Tools/ISAInstructionPartReader.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Tools/ISAInstructionReader.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Tools/ISAModRMReader.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Tools/ISAOpcodeReader.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Tools/ISAPrefixReader.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Tools/ISASibReader.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Tools/ModRM.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Tools/OctalStructure.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/Tools/SIB.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/VEXPrefix.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/WinX64ABI.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/X64ABI.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/Intel/X86ABI.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/NativeCodeReference.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/RISCCodeGenerator.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/RISCV/RV64CodeGenerator.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/RISCV/RegistersRISCV.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/RelocatableBuffer.Class.st create mode 100644 modules/LMR/Nativizer/Assembly/RelocationFixup.Class.st create mode 100644 modules/LMR/Nativizer/BinaryMessageNativizer.Class.st create mode 100644 modules/LMR/Nativizer/CompositeMessageLinker.Class.st create mode 100644 modules/LMR/Nativizer/HaltingSend.Class.st create mode 100644 modules/LMR/Nativizer/InlineMessageLinker.Class.st create mode 100644 modules/LMR/Nativizer/InlinedMessageNativizer.Class.st create mode 100644 modules/LMR/Nativizer/InvokeLinker.Class.st create mode 100644 modules/LMR/Nativizer/LazyLinker.Class.st create mode 100644 modules/LMR/Nativizer/LookupLinker.Class.st create mode 100644 modules/LMR/Nativizer/LookupNativizer.Class.st create mode 100644 modules/LMR/Nativizer/MessageLinker.Class.st create mode 100644 modules/LMR/Nativizer/NativizationEnvironment.Class.st create mode 100644 modules/LMR/Nativizer/NativizationPlatform.Class.st create mode 100644 modules/LMR/Nativizer/NativizerModule.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OActivationContext.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OBasicBlock.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OBeginInstruction.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OBinaryConstantOperation.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OBinaryOperation.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OBinaryVariableOperation.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OBlockClosure.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OComposedLiveRange.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OConstant.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/ODefineArgument.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/ODominatorTree.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OEndInstruction.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OInstruction.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OJump.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OJumpConditional.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OJumpFalse.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OJumpTrue.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OLiveRange.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OLoadConstant.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OLoadImplicit.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OMessageSend.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OOperand.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OPhi.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OPrimitiveOperation.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OReadVariable.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OReturn.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OSimpleLiveRange.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OTemporary.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OTernaryOperation.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OTiling.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OUnaryOperation.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OUseVariable.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OValue.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OVariable.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/OWriteVariable.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/IR/Object.Extension.st create mode 100644 modules/LMR/Nativizer/OCompiler/NativizationEnvironment.Extension.st create mode 100644 modules/LMR/Nativizer/OCompiler/Object.Extension.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingBlockInliner.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingBraunAllocator.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingBraunAssigner.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingCFGSimplifier.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingCSSATransformer.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingCodeEmitter.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingInstructionFragmenter.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingInstructionSelector.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingLivenessAnalysis.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingMethodInliner.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingNativizer.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingPhiSimplification.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingRegisterAllocator.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingSSAReconstructor.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingTwoAddressEnforcer.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingUsesVerifier.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingValueNumbering.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingVariableBinder.Class.st create mode 100644 modules/LMR/Nativizer/OCompiler/OptimizingVisitor.Class.st create mode 100644 modules/LMR/Nativizer/TemplateJIT.Class.st create mode 100644 modules/LMR/Nativizer/Tests/TemplateJIT.Class.st create mode 100644 modules/LMR/NonMovingCollector.Class.st create mode 100644 modules/LMR/PinnedAllocator.Class.st create mode 100644 modules/LMR/ReifiedStackFrameCursor.Class.st create mode 100644 modules/LMR/RememberedSet.Class.st create mode 100644 modules/LMR/SExpressions/CompiledMethod.Extension.st create mode 100644 modules/LMR/SExpressions/SArgumentBinding.Class.st create mode 100644 modules/LMR/SExpressions/SAssignment.Class.st create mode 100644 modules/LMR/SExpressions/SAssociationBinding.Class.st create mode 100644 modules/LMR/SExpressions/SBinding.Class.st create mode 100644 modules/LMR/SExpressions/SBlock.Class.st create mode 100644 modules/LMR/SExpressions/SCascade.Class.st create mode 100644 modules/LMR/SExpressions/SCascadeMessage.Class.st create mode 100644 modules/LMR/SExpressions/SDynamicBinding.Class.st create mode 100644 modules/LMR/SExpressions/SExpression.Class.st create mode 100644 modules/LMR/SExpressions/SExpressionsModule.Class.st create mode 100644 modules/LMR/SExpressions/SFalseBinding.Class.st create mode 100644 modules/LMR/SExpressions/SIdentifier.Class.st create mode 100644 modules/LMR/SExpressions/SInlinerOperation.Class.st create mode 100644 modules/LMR/SExpressions/SInstVarBinding.Class.st create mode 100644 modules/LMR/SExpressions/SLiteral.Class.st create mode 100644 modules/LMR/SExpressions/SLiteralBinding.Class.st create mode 100644 modules/LMR/SExpressions/SLiteralVar.Class.st create mode 100644 modules/LMR/SExpressions/SLocalBinding.Class.st create mode 100644 modules/LMR/SExpressions/SMessage.Class.st create mode 100644 modules/LMR/SExpressions/SMethod.Class.st create mode 100644 modules/LMR/SExpressions/SNestedDynamicBinding.Class.st create mode 100644 modules/LMR/SExpressions/SNilBinding.Class.st create mode 100644 modules/LMR/SExpressions/SOpAssign.Class.st create mode 100644 modules/LMR/SExpressions/SOpDispatchMessage.Class.st create mode 100644 modules/LMR/SExpressions/SOpDropToS.Class.st create mode 100644 modules/LMR/SExpressions/SOpJump.Class.st create mode 100644 modules/LMR/SExpressions/SOpJumpFalse.Class.st create mode 100644 modules/LMR/SExpressions/SOpJumpTrue.Class.st create mode 100644 modules/LMR/SExpressions/SOpLoadRfromFrame.Class.st create mode 100644 modules/LMR/SExpressions/SOpLoadRfromStack.Class.st create mode 100644 modules/LMR/SExpressions/SOpLoadRwithNil.Class.st create mode 100644 modules/LMR/SExpressions/SOpLoadRwithSelf.Class.st create mode 100644 modules/LMR/SExpressions/SOpNonLocalReturn.Class.st create mode 100644 modules/LMR/SExpressions/SOpPopR.Class.st create mode 100644 modules/LMR/SExpressions/SOpPrimitive.Class.st create mode 100644 modules/LMR/SExpressions/SOpPushR.Class.st create mode 100644 modules/LMR/SExpressions/SOpRestart.Class.st create mode 100644 modules/LMR/SExpressions/SOpReturn.Class.st create mode 100644 modules/LMR/SExpressions/SOpStoreRintoFrame.Class.st create mode 100644 modules/LMR/SExpressions/SOperation.Class.st create mode 100644 modules/LMR/SExpressions/SPragma.Class.st create mode 100644 modules/LMR/SExpressions/SReturn.Class.st create mode 100644 modules/LMR/SExpressions/SScript.Class.st create mode 100644 modules/LMR/SExpressions/SSelfBinding.Class.st create mode 100644 modules/LMR/SExpressions/SSuperBinding.Class.st create mode 100644 modules/LMR/SExpressions/STemporaryBinding.Class.st create mode 100644 modules/LMR/SExpressions/STrueBinding.Class.st create mode 100644 modules/LMR/SExpressions/TreecodeDecoder.Class.st create mode 100644 modules/LMR/SendSite.Class.st create mode 100644 modules/LMR/StackChunk.Class.st create mode 100644 modules/LMR/StackFrameCursor.Class.st create mode 100644 modules/LMR/Thread.Class.st create mode 100644 modules/ModuleImporter/CharacterArray.Extension.st create mode 100644 modules/ModuleImporter/ModuleImporterModule.Class.st create mode 100644 modules/ModuleImporter/ModuleLoader.Class.st create mode 100644 modules/ModuleImporter/ModuleSpecReader.Class.st create mode 100644 modules/NOS/Devices/Memory/Memory.Class.st create mode 100644 modules/NOS/Devices/Memory/MemoryBlock.Class.st create mode 100644 modules/NOS/Devices/Memory/MemoryManagerStrategy.Class.st create mode 100644 modules/NOS/Devices/Network/InternalNetworkDevice.Class.st create mode 100644 modules/NOS/Devices/Network/LanceNICInitializationBlock16.Class.st create mode 100644 modules/NOS/Devices/Network/LanceNICReceiveRingDescriptor16.Class.st create mode 100644 modules/NOS/Devices/Network/LanceNICRingDescriptor16.Class.st create mode 100644 modules/NOS/Devices/Network/LanceNICTransmitRingDescriptor16.Class.st create mode 100644 modules/NOS/Devices/Network/LancePCIDevice.Class.st create mode 100644 modules/NOS/Devices/Network/Loopback.Class.st create mode 100644 modules/NOS/Devices/Network/NetworkingDevice.Class.st create mode 100644 modules/NOS/Devices/Network/PacketCapturerFile.Class.st create mode 100644 modules/NOS/Devices/Network/PacketSocket.Class.st create mode 100644 modules/NOS/Devices/Network/PacketSocketPlugin.Class.st create mode 100644 modules/NOS/Devices/Network/Realtek8139PCIDevice.Class.st create mode 100644 modules/NOS/Devices/Network/SLIP.Class.st create mode 100644 modules/NOS/Devices/PC/CMOS.Class.st create mode 100644 modules/NOS/Devices/PC/OldPCKeyboard.Class.st create mode 100644 modules/NOS/Devices/PC/PCIBusEntry.Class.st create mode 100644 modules/NOS/Devices/PC/PCIDevice.Class.st create mode 100644 modules/NOS/Devices/PC/PIC8259.Class.st create mode 100644 modules/NOS/Devices/PC/PS2Keyboard.Class.st create mode 100644 modules/NOS/Devices/PC/ScancodeDecoder.Class.st create mode 100644 modules/NOS/Devices/PC/UART16550.Class.st create mode 100644 modules/NOS/Devices/PC/UART8250.Class.st create mode 100644 modules/NOS/Devices/Processor/MicroProcessor.Class.st create mode 100644 modules/NOS/Devices/Processor/X86Processor.Class.st create mode 100644 modules/NOS/Devices/Storage/ATABenchmarker.Class.st create mode 100644 modules/NOS/Devices/Storage/ATAController.Class.st create mode 100644 modules/NOS/Devices/Storage/ATAControllerTest.Class.st create mode 100644 modules/NOS/Devices/Storage/ATADevice.Class.st create mode 100644 modules/NOS/Devices/Storage/ATARawController.Class.st create mode 100644 modules/NOS/Devices/Storage/ATATest.Class.st create mode 100644 modules/NOS/Devices/Storage/BlockDevice.Class.st create mode 100644 modules/NOS/Devices/Storage/BlockDeviceTest.Class.st create mode 100644 modules/NOS/Devices/Storage/BlockDevicesTest.Class.st create mode 100644 modules/NOS/Devices/Storage/IDEHardDiskDeviceInformation.Class.st create mode 100644 modules/NOS/Devices/Storage/PCIBusMaster.Class.st create mode 100644 modules/NOS/Devices/Storage/PhysicalRegionDescriptorTable.Class.st create mode 100644 modules/NOS/Devices/USB/SDDevice.Class.st create mode 100644 modules/NOS/Devices/USB/USBQueueHead.Class.st create mode 100644 modules/NOS/Devices/USB/USBTransferDescriptor.Class.st create mode 100644 modules/NOS/Devices/USB/USBUHCIController.Class.st create mode 100644 modules/NOS/External/Buffer.Class.st create mode 100644 modules/NOS/External/DisplayInformation.Class.st create mode 100644 modules/NOS/External/ElfSectionHeaderTable.Class.st create mode 100644 modules/NOS/External/KernelModule.Class.st create mode 100644 modules/NOS/External/MultiBootInfo.Class.st create mode 100644 modules/NOS/External/MultiBootMemoryMap.Class.st create mode 100644 modules/NOS/External/MultiBootMemoryMapEntry.Class.st create mode 100644 modules/NOS/External/ReadonlyPage.Class.st create mode 100644 modules/NOS/External/SnapshotInfo.Class.st create mode 100644 modules/NOS/External/SymbolTable.Class.st create mode 100644 modules/NOS/External/VMBridge.Class.st create mode 100644 modules/NOS/FileSupport/DeviceStream.Class.st create mode 100644 modules/NOS/FileSupport/NopsysResolver.Class.st create mode 100644 modules/NOS/FileSupport/ParagraphEditorWithBindings.Class.st create mode 100644 modules/NOS/FileSupport/RemoteFileDirectory.Class.st create mode 100644 modules/NOS/FileSupport/RemoteMultiByteFileStream.Class.st create mode 100644 modules/NOS/FileSupport/RemoteObjectChannel.Class.st create mode 100644 modules/NOS/FileSupport/RemoteWorkspace.Class.st create mode 100644 modules/NOS/FileSystems/FAT32/ExampleFAT32FileSystemTest.Class.st create mode 100644 modules/NOS/FileSystems/FAT32/FAT32BootRecord.Class.st create mode 100644 modules/NOS/FileSystems/FAT32/FAT32Cluster.Class.st create mode 100644 modules/NOS/FileSystems/FAT32/FAT32ClusterRecord.Class.st create mode 100644 modules/NOS/FileSystems/FAT32/FAT32FileAllocationTable.Class.st create mode 100644 modules/NOS/FileSystems/FAT32/FAT32FileSystem.Class.st create mode 100644 modules/NOS/FileSystems/FAT32/FAT32FileSystemTest.Class.st create mode 100644 modules/NOS/FileSystems/MultiByteFilesystemFileStream.Class.st create mode 100644 modules/NOS/FileSystems/NOSDirectory.Class.st create mode 100644 modules/NOS/FileSystems/NOSFile.Class.st create mode 100644 modules/NOS/FileSystems/NOSFilesystemContent.Class.st create mode 100644 modules/NOS/Kernel/Computer.Class.st create mode 100644 modules/NOS/Kernel/ExternalIOPort.Class.st create mode 100644 modules/NOS/Kernel/HardwareDevice.Class.st create mode 100644 modules/NOS/Kernel/ImageSnapshotter.Class.st create mode 100644 modules/NOS/Kernel/InterruptRequestDispatcher.Class.st create mode 100644 modules/NOS/MemoryManager/MemoryManagerStrategy.Class.st create mode 100644 modules/NOS/MemoryManager/PageFaultHandler.Class.st create mode 100644 modules/NOS/MemoryManager/PageManager.Class.st create mode 100644 modules/NOS/MemoryManager/Paging/PageDirectory.Class.st create mode 100644 modules/NOS/MemoryManager/Paging/PageDirectoryRecord.Class.st create mode 100644 modules/NOS/MemoryManager/Paging/PageFaultParameters.Class.st create mode 100644 modules/NOS/MemoryManager/Paging/PageIndex.Class.st create mode 100644 modules/NOS/MemoryManager/Paging/PageTable.Class.st create mode 100644 modules/NOS/MemoryManager/Paging/PageTableEntry.Class.st create mode 100644 modules/NOS/MemoryManager/PagingTest.Class.st create mode 100644 modules/NOS/Network/Conduit/Conduit.Class.st create mode 100644 modules/NOS/Network/Conduit/ConduitAlarm.Class.st create mode 100644 modules/NOS/Network/Conduit/ConduitTimer.Class.st create mode 100644 modules/NOS/Network/Conduit/InternalRawSocket.Class.st create mode 100644 modules/NOS/Network/Conduit/InternalSocket.Class.st create mode 100644 modules/NOS/Network/Exceptions/ConnectionRefused.Class.st create mode 100644 modules/NOS/Network/Exceptions/ConnectionReset.Class.st create mode 100644 modules/NOS/Network/Exceptions/HostDown.Class.st create mode 100644 modules/NOS/Network/Exceptions/NetDown.Class.st create mode 100644 modules/NOS/Network/Exceptions/OutOfBandData.Class.st create mode 100644 modules/NOS/Network/Interfaces/IPInterface.Class.st create mode 100644 modules/NOS/Network/Interfaces/NetInterface.Class.st create mode 100644 modules/NOS/Network/Missing/Ping.Class.st create mode 100644 modules/NOS/Network/Missing/TCPSynScanner.Class.st create mode 100644 modules/NOS/Network/Missing/TraceRoute.Class.st create mode 100644 modules/NOS/Network/Options/IP/IPOption.Class.st create mode 100644 modules/NOS/Network/Options/IP/IPTimestamp.Class.st create mode 100644 modules/NOS/Network/Options/IP/LSRR.Class.st create mode 100644 modules/NOS/Network/Options/IP/RecordRoute.Class.st create mode 100644 modules/NOS/Network/Options/IP/SSRR.Class.st create mode 100644 modules/NOS/Network/Options/TCP/MSS.Class.st create mode 100644 modules/NOS/Network/Options/TCP/SACK.Class.st create mode 100644 modules/NOS/Network/Options/TCP/TCPOption.Class.st create mode 100644 modules/NOS/Network/Options/TCP/TCPTimestamp.Class.st create mode 100644 modules/NOS/Network/Options/TCP/WindowScale.Class.st create mode 100644 modules/NOS/Network/Packets/EGPPacket.Class.st create mode 100644 modules/NOS/Network/Packets/ICMPPacket.Class.st create mode 100644 modules/NOS/Network/Packets/IGMPPacket.Class.st create mode 100644 modules/NOS/Network/Packets/IGRPPacket.Class.st create mode 100644 modules/NOS/Network/Packets/IPPacket.Class.st create mode 100644 modules/NOS/Network/Packets/IPv6Packet.Class.st create mode 100644 modules/NOS/Network/Packets/IRTPPacket.Class.st create mode 100644 modules/NOS/Network/Packets/Packet.Class.st create mode 100644 modules/NOS/Network/Packets/PacketOption.Class.st create mode 100644 modules/NOS/Network/Packets/RARPPacket.Class.st create mode 100644 modules/NOS/Network/Packets/RDPPacket.Class.st create mode 100644 modules/NOS/Network/Packets/TCPPacket.Class.st create mode 100644 modules/NOS/Network/Packets/UDPPacket.Class.st create mode 100644 modules/NOS/Network/Packets/WirelessPacket.Class.st create mode 100644 modules/NOS/Network/Protocols/Ethernet/ARP.Class.st create mode 100644 modules/NOS/Network/Protocols/Ethernet/ARPEntry.Class.st create mode 100644 modules/NOS/Network/Protocols/Ethernet/ARPPacket.Class.st create mode 100644 modules/NOS/Network/Protocols/Ethernet/ARPRequest.Class.st create mode 100644 modules/NOS/Network/Protocols/Ethernet/Ethernet.Class.st create mode 100644 modules/NOS/Network/Protocols/Ethernet/EthernetAddress.Class.st create mode 100644 modules/NOS/Network/Protocols/Ethernet/EthernetInterface.Class.st create mode 100644 modules/NOS/Network/Protocols/Ethernet/EthernetPacket.Class.st create mode 100644 modules/NOS/Network/Protocols/Ethernet/Route.Class.st create mode 100644 modules/NOS/Network/Protocols/Ethernet/RoutingTable.Class.st create mode 100644 modules/NOS/Network/Protocols/IP/ICMP.Class.st create mode 100644 modules/NOS/Network/Protocols/IP/IP.Class.st create mode 100644 modules/NOS/Network/Protocols/IP/IPChannel.Class.st create mode 100644 modules/NOS/Network/Protocols/IP/IPReassembler.Class.st create mode 100644 modules/NOS/Network/Protocols/IP/IPReassemblyList.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/InternalTCPSocket.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPCloseWait.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPClosed.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPClosing.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPEstablished.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPFinWait1.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPFinWait2.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPIdle.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPLastACK.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPListen.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPOutputState.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPPersist.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPRetransmit.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPState.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPSynReceived.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPSynSent.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPTimeWait.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/States/TCPTransmit.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/TCP.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/TCPChannel.Class.st create mode 100644 modules/NOS/Network/Protocols/TCP/TCPReassembler.Class.st create mode 100644 modules/NOS/Network/Protocols/UDP/InternalUDPSocket.Class.st create mode 100644 modules/NOS/Network/Protocols/UDP/UDP.Class.st create mode 100644 modules/NOS/Network/Protocols/UDP/UDPChannel.Class.st create mode 100644 modules/NOS/Network/Support/BitArray.Class.st create mode 100644 modules/NOS/Network/Support/CircularBuffer.Class.st create mode 100644 modules/NOS/Network/Support/InternetAddress.Class.st create mode 100644 modules/NOS/Network/Support/NetAddress.Class.st create mode 100644 modules/NOS/Network/Support/NetBlock.Class.st create mode 100644 modules/NOS/Network/Support/NetStream.Class.st create mode 100644 modules/NOS/Network/Support/TCPSequenceNumber.Class.st create mode 100644 modules/NOS/Network/Tests/IPFragmentsTest.Class.st create mode 100644 modules/NOS/Network/Tests/IPOptionsTest.Class.st create mode 100644 modules/NOS/Network/Tests/IPTest.Class.st create mode 100644 modules/NOS/Network/Tests/NetHighLevelTest.Class.st create mode 100644 modules/NOS/Network/Tests/PacketInspector.Class.st create mode 100644 modules/NOS/Network/Tests/PluggableConduit.Class.st create mode 100644 modules/NOS/Network/Tests/RealisticLoopback.Class.st create mode 100644 modules/NOS/Network/Tests/SqueakNOSNetworkTest.Class.st create mode 100644 modules/NOS/Network/Tests/TCPPacketTest.Class.st create mode 100644 modules/NOS/Network/Tests/TCPReassemblerTest.Class.st create mode 100644 modules/NOS/Network/Tests/TCPSequenceTest.Class.st create mode 100644 modules/NOS/Network/Tests/TCPTest.Class.st create mode 100644 modules/NOS/OFW-OLPC/OFWDeviceNode.Class.st create mode 100644 modules/NOS/OFW-OLPC/OpenFirmwareCalloutClient.Class.st create mode 100644 modules/NOS/Storage/BlockArithmetic.Class.st create mode 100644 modules/NOS/Storage/BlockArithmetic0.Class.st create mode 100644 modules/NOS/Storage/BlockCache.Class.st create mode 100644 modules/NOS/Storage/BlockCacheTest.Class.st create mode 100644 modules/NOS/Storage/BlockDeviceOnStream.Class.st create mode 100644 modules/NOS/Storage/BlockDeviceSegment.Class.st create mode 100644 modules/NOS/Storage/ByteArrayOnBlockDevice.Class.st create mode 100644 modules/NOS/Storage/ByteArrayOnStream.Class.st create mode 100644 modules/NOS/Storage/ByteArraySegment.Class.st create mode 100644 modules/NOS/Storage/CheapHardDiskStream.Class.st create mode 100644 modules/NOS/Storage/DualTestBlockDevice.Class.st create mode 100644 modules/NOS/Storage/MasterBootRecord.Class.st create mode 100644 modules/NOS/Storage/MemoryBlockDevice.Class.st create mode 100644 modules/NOS/Storage/NullBlockCache.Class.st create mode 100644 modules/NOS/Storage/PartitionRecord.Class.st create mode 100644 modules/NOS/Storage/ReadBlockCache.Class.st create mode 100644 modules/NOS/Storage/Segment.Class.st create mode 100644 modules/NOS/Storage/StreamOnStream.Class.st create mode 100644 modules/NOS/Storage/Tests/BlockArithmeticTest.Class.st create mode 100644 modules/NOS/Storage/Tests/BlockCacheTest.Class.st create mode 100644 modules/NOS/Storage/Tests/MemoryBlockDeviceTest.Class.st create mode 100644 modules/NOS/Storage/Tests/StreamOnStreamTest.Class.st create mode 100644 modules/NOS/Storage/Tests/WriteListTest.Class.st create mode 100644 modules/NOS/Storage/WriteList.Class.st create mode 100644 modules/PetitParser/Extensions/Character.Extension.st create mode 100644 modules/PetitParser/Extensions/CharacterArray.Extension.st create mode 100644 modules/PetitParser/Extensions/Closure.Extension.st create mode 100644 modules/PetitParser/Extensions/ExtensionsModule.Class.st create mode 100644 modules/PetitParser/Extensions/Object.Extension.st create mode 100644 modules/PetitParser/Extensions/ReadStream.Extension.st create mode 100644 modules/PetitParser/Extensions/SequenceableCollection.Extension.st create mode 100644 modules/PetitParser/Extensions/Set.Extension.st create mode 100644 modules/PetitParser/Extensions/Symbol.Extension.st create mode 100644 modules/PetitParser/Extensions/UndefinedObject.Extension.st create mode 100644 modules/PetitParser/PPFailure.Class.st create mode 100644 modules/PetitParser/PPMemento.Class.st create mode 100644 modules/PetitParser/PPStream.Class.st create mode 100644 modules/PetitParser/PPToken.Class.st create mode 100644 modules/PetitParser/Parsers/PPActionParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPAndParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPCharSetPredicate.Class.st create mode 100644 modules/PetitParser/Parsers/PPChoiceParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPDelegateParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPEndOfInputParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPEpsilonParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPFailingParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPFlattenParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPListParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPLiteralObjectParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPLiteralParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPLiteralSequenceParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPMappedParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPMemoizedParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPNotParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPOptionalParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPPluggableParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPPredicateObjectParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPPredicateParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPPredicateSequenceParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPRepeatingParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPSequenceParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPSequencedChoiceParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPTokenParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPTrimmingParser.Class.st create mode 100644 modules/PetitParser/Parsers/PPWrappingParser.Class.st create mode 100644 modules/PetitParser/PetitParserModule.Class.st create mode 100644 modules/PetitParser/Tools/PPCompositeParser.Class.st create mode 100644 modules/PetitParser/Tools/PPExpressionParser.Class.st create mode 100644 modules/PetitParser/Tools/PPUnresolvedParser.Class.st create mode 100644 modules/PetitParser/Tools/ToolsModule.Class.st create mode 100644 modules/Random/Random.Class.st create mode 100644 modules/Random/RandomModule.Class.st create mode 100644 modules/Random/Tests/RandomTest.Class.st create mode 100644 modules/Random/Tests/TestsModule.Class.st create mode 100644 modules/STON/Association.Extension.st create mode 100644 modules/STON/Boolean.Extension.st create mode 100644 modules/STON/ByteArray class.Extension.st create mode 100644 modules/STON/Character class.Extension.st create mode 100644 modules/STON/Class class.Extension.st create mode 100644 modules/STON/Closure.Extension.st create mode 100644 modules/STON/Collection class.Extension.st create mode 100644 modules/STON/Date class.Extension.st create mode 100644 modules/STON/Dictionary class.Extension.st create mode 100644 modules/STON/HashedCollection.Extension.st create mode 100644 modules/STON/Integer.Extension.st create mode 100644 modules/STON/Interval class.Extension.st create mode 100644 modules/STON/Metaclass class.Extension.st create mode 100644 modules/STON/Number.Extension.st create mode 100644 modules/STON/Object class.Extension.st create mode 100644 modules/STON/OrderedDictionary.Extension.st create mode 100644 modules/STON/Point.Extension.st create mode 100644 modules/STON/STON.Class.st create mode 100644 modules/STON/STONJSON.Class.st create mode 100644 modules/STON/STONMapWriter.Class.st create mode 100644 modules/STON/STONModule.Class.st create mode 100644 modules/STON/STONReader.Class.st create mode 100644 modules/STON/STONReaderError.Class.st create mode 100644 modules/STON/STONReference.Class.st create mode 100644 modules/STON/STONStreamWriter.Class.st create mode 100644 modules/STON/STONWriter.Class.st create mode 100644 modules/STON/STONWriterError.Class.st create mode 100644 modules/STON/SequenceableCollection class.Extension.st create mode 100644 modules/STON/String.Extension.st create mode 100644 modules/STON/Symbol.Extension.st create mode 100644 modules/STON/Time class.Extension.st create mode 100644 modules/STON/Timestamp class.Extension.st create mode 100644 modules/STON/UndefinedObject.Extension.st create mode 100644 modules/SUnit/CharacterArray.Extension.st create mode 100644 modules/SUnit/Class.Extension.st create mode 100644 modules/SUnit/Closure.Extension.st create mode 100644 modules/SUnit/CompiledExpression.Extension.st create mode 100644 modules/SUnit/CompiledMethod.Extension.st create mode 100644 modules/SUnit/Exception.Extension.st create mode 100644 modules/SUnit/ExceptionHandler.Extension.st create mode 100644 modules/SUnit/Object.Extension.st create mode 100644 modules/SUnit/SUnitModule.Class.st create mode 100644 modules/SUnit/SUnitNameResolver.Class.st create mode 100644 modules/SUnit/Species.Extension.st create mode 100644 modules/SUnit/Symbol.Extension.st create mode 100644 modules/SUnit/TestCase.Class.st create mode 100644 modules/SUnit/TestCounter.Class.st create mode 100644 modules/SUnit/TestFailure.Class.st create mode 100644 modules/SUnit/TestResource.Class.st create mode 100644 modules/SUnit/TestResult.Class.st create mode 100644 modules/SUnit/TestSkipped.Class.st create mode 100644 modules/SUnit/TestSuite.Class.st create mode 100644 modules/SUnit/Tests/ExampleSetTest.Class.st create mode 100644 modules/SUnit/Tests/ResumableTestFailureTestCase.Class.st create mode 100644 modules/SUnit/Tests/SUnitTest.Class.st create mode 100644 modules/SUnit/Tests/SimpleTestResource.Class.st create mode 100644 modules/SUnit/Tests/SimpleTestResourceTestCase.Class.st create mode 100644 modules/SUnit/Tests/TestsModule.Class.st create mode 100644 modules/TOML/TOMLModule.Class.st create mode 100644 modules/TOML/TOMLParser.Class.st create mode 100644 modules/TOML/TOMLWriter.Class.st create mode 100644 modules/TOML/Tests/TOMLParserTest.Class.st create mode 100644 modules/TOML/Tests/TestsModule.Class.st create mode 100644 modules/TinyBenchmarks/TinyBenchmarksModule.Class.st create mode 100644 modules/Tonel/Loader/LoaderModule.Class.st create mode 100644 modules/Tonel/Loader/TonelLoader.Class.st create mode 100644 modules/Tonel/Module.Extension.st create mode 100644 modules/Tonel/ReadStream.Extension.st create mode 100644 modules/Tonel/Tests/TestsModule.Class.st create mode 100644 modules/Tonel/Tests/TonelWriterTest.Class.st create mode 100644 modules/Tonel/TonelModule.Class.st create mode 100644 modules/Tonel/TonelReader.Class.st create mode 100644 modules/Tonel/TonelWriter.Class.st create mode 100644 modules/Webside/ByteArray.Extension.st create mode 100644 modules/Webside/Class.Extension.st create mode 100644 modules/Webside/CompiledMethod.Extension.st create mode 100644 modules/Webside/Metaclass.Extension.st create mode 100644 modules/Webside/Object.Extension.st create mode 100644 modules/Webside/Species.Extension.st create mode 100644 modules/Webside/WebsideAPI.Class.st create mode 100644 modules/Webside/WebsideApplication.Class.st create mode 100644 modules/Webside/WebsideModule.Class.st diff --git a/modules/ArgParser/ArgParser.Class.st b/modules/ArgParser/ArgParser.Class.st new file mode 100644 index 00000000..639cd53e --- /dev/null +++ b/modules/ArgParser/ArgParser.Class.st @@ -0,0 +1,108 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ArgParser category: #ArgParser! +Object subclass: #ArgParser + instanceVariableNames: 'name description commands globalOptions' + classVariableNames: '' + poolDictionaries: '' + category: 'ArgParser'! +!ArgParser commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!ArgParser methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:37'! +addCommand: aCommand + commands at: aCommand name put: aCommand +! ! + +!ArgParser methodsFor: 'options' stamp: 'KenD 28/Jun/2026 13:27:37'! +addGlobalOption: anOption + globalOptions add: anOption +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description + ^description +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description: aString + description := aString +! ! + +!ArgParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +extractGlobalArgs: args + | remaining i | + remaining := OrderedCollection new. + i := 1. + [i <= args size] whileTrue: [ + | arg match rest | + arg := args at: i. + match := globalOptions detect: [:opt | opt matches: arg] ifNone: [nil]. + match ifNotNil: [ + match hasValue ifTrue: [i := i + 1] + ] ifNil: [ + rest := args copyFrom: i to: args size. + ^remaining addAll: rest; yourself]. + i := i + 1]. + ^remaining +! ! + +!ArgParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + commands := OrderedDictionary new. + globalOptions := OrderedCollection new +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name + ^name +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name: aString + name := aString +! ! + +!ArgParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parse: args + | remaining key command result tail | + remaining := self extractGlobalArgs: args. + remaining isEmpty ifTrue: [self printHelp. ^nil]. + key := remaining first. + command := commands at: key ifAbsent: [ + self error: 'Unknown command: ', key, '. Run with no args for help.']. + result := ParseResult new. + result command: key. + tail := remaining copyFrom: 2 to: remaining size. + command parse: tail into: result. + command action ifNotNil: [:act | act value: result]. + ^result +! ! + +!ArgParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +printHelp + | text | + text := name ifNil: ['command']. + description ifNotNil: [ + text := text , ' - ' , description]. + text := text , String cr , String cr , 'Commands:' , String cr. + commands keysAndValuesDo: [:key :cmd | + text := text , ' ' , key. + cmd description ifNotNil: [:d | + text := text , ' - ' , d]. + text := text , String cr]. + Kernel log: text +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ArgParser class' category: #ArgParser! +ArgParser class + instanceVariableNames: ''! + + +ArgParser initialize! + diff --git a/modules/ArgParser/ArgParserModule.Class.st b/modules/ArgParser/ArgParserModule.Class.st new file mode 100644 index 00000000..adddffef --- /dev/null +++ b/modules/ArgParser/ArgParserModule.Class.st @@ -0,0 +1,28 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ArgParserModule category: #ArgParser! +Module subclass: #ArgParserModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ArgParser'! +!ArgParserModule commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!ArgParserModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(Error OrderedDictionary). + } +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ArgParserModule class' category: #ArgParser! +ArgParserModule class + instanceVariableNames: ''! + + diff --git a/modules/ArgParser/Command.Class.st b/modules/ArgParser/Command.Class.st new file mode 100644 index 00000000..03030ceb --- /dev/null +++ b/modules/ArgParser/Command.Class.st @@ -0,0 +1,163 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #Command category: #ArgParser! +Object subclass: #Command + instanceVariableNames: 'name description options positionalNames action subcommands' + classVariableNames: '' + poolDictionaries: '' + category: 'ArgParser'! +!Command commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +action + ^action +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +action: aBlock + action := aBlock +! ! + +!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! +addOption: anOption + options add: anOption +! ! + +!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! +addPositional: aString + positionalNames add: aString +! ! + +!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! +addSubcommand: aCommand + subcommands at: aCommand name put: aCommand +! ! + +!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +applyDefaults: aResult + options do: [:opt | + (aResult hasOption: opt name) ifFalse: [ + opt defaultValue ifNotNil: [:v | + aResult setOption: opt name to: v]]] +! ! + +!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +checkRequired: aResult + options do: [:opt | + | name | + name := opt long ifNil: [opt short]. + (opt required and: [(aResult hasOption: opt name) not]) + ifTrue: [self error: 'Required option missing: ', name]] +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description + ^description +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description: aString + description := aString +! ! + +!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +findOption: aString + ^options detect: [:opt | opt matches: aString] ifNone: [nil] +! ! + +!Command methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasSubcommands + ^subcommands notEmpty +! ! + +!Command methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + options := OrderedCollection new. + positionalNames := OrderedCollection new. + subcommands := OrderedDictionary new +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name + ^name +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name: aString + name := aString +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +options + ^options +! ! + +!Command methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parse: args into: result + | i | + i := 1. + [i <= args size] whileTrue: [ + | arg | + arg := args at: i. + (arg first = $-) + ifTrue: [i := self parseOption: arg from: args at: i into: result] + ifFalse: [result addPositional: arg]. + i := i + 1]. + self checkRequired: result. + self applyDefaults: result +! ! + +!Command methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseOption: aString from: anArray at: anInteger into: aResult + | opt | + opt := self findOption: aString. + opt ifNil: [self error: 'Unknown option: ', aString]. + opt hasValue ifTrue: [ + | val next | + next := anInteger + 1. + next > anArray size ifTrue: [self error: 'Option ', aString, ' requires a value']. + val := anArray at: next. + aResult setOption: opt name to: val. + ^next] + ifFalse: [ + aResult setOption: opt name to: true]. + ^anInteger +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +positionalNames + ^positionalNames +! ! + +!Command methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +printUsageOn: aStream + aStream nextPutAll: name. + positionalNames do: [:pname | + aStream nextPutAll: ' <'; nextPutAll: pname; nextPut: $>]. + options do: [:opt | + aStream nextPutAll: ' ['. + opt short ifNotNil: [:s | aStream nextPutAll: s]. + (opt short notNil and: [opt long notNil]) ifTrue: [aStream nextPutAll: '|']. + opt long ifNotNil: [:l | aStream nextPutAll: l]. + opt hasValue ifTrue: [aStream nextPutAll: ' ']. + aStream nextPut: $]] +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +subcommands + ^subcommands +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Command class' category: #ArgParser! +Command class + instanceVariableNames: ''! + + +Command initialize! + diff --git a/modules/ArgParser/Option.Class.st b/modules/ArgParser/Option.Class.st new file mode 100644 index 00000000..d39fe77a --- /dev/null +++ b/modules/ArgParser/Option.Class.st @@ -0,0 +1,102 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #Option category: #ArgParser! +Object subclass: #Option + instanceVariableNames: 'short long description required hasValue defaultValue' + classVariableNames: '' + poolDictionaries: '' + category: 'ArgParser'! +!Option commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!Option methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! +beFlag + hasValue := false. + defaultValue := false +! ! + +!Option methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! +beRequired + required := true +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +defaultValue + ^defaultValue +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +defaultValue: anObject + defaultValue := anObject +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description + ^description +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description: aString + description := aString +! ! + +!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasValue + ^hasValue +! ! + +!Option methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + required := false. + hasValue := true. + defaultValue := nil +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +long + ^long +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +long: aString + long := aString +! ! + +!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +matches: aString + ^aString = short or: [aString = long] +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name + long ifNotNil: [^long copyFrom: 3]. + ^short copyFrom: 2 +! ! + +!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +required + ^required +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +short + ^short +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +short: aString + short := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Option class' category: #ArgParser! +Option class + instanceVariableNames: ''! + + +Option initialize! + diff --git a/modules/ArgParser/ParseResult.Class.st b/modules/ArgParser/ParseResult.Class.st new file mode 100644 index 00000000..b07ce60d --- /dev/null +++ b/modules/ArgParser/ParseResult.Class.st @@ -0,0 +1,79 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ParseResult category: #ArgParser! +Object subclass: #ParseResult + instanceVariableNames: 'command positionals options' + classVariableNames: '' + poolDictionaries: '' + category: 'ArgParser'! +!ParseResult commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addPositional: aString + positionals add: aString +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +command + ^command +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +command: aString + command := aString +! ! + +!ParseResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasOption: aString + ^options includesKey: aString +! ! + +!ParseResult methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + positionals := OrderedCollection new. + options := OrderedDictionary new +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +optionAt: aString + ^options at: aString ifAbsent: [nil] +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +optionAt: aString ifAbsent: aBlock + ^options at: aString ifAbsent: aBlock +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +options + ^options +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +positionalAt: anInteger + ^positionals at: anInteger +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +positionals + ^positionals +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +setOption: aString to: aValue + options at: aString put: aValue +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ParseResult class' category: #ArgParser! +ParseResult class + instanceVariableNames: ''! + + +ParseResult initialize! + diff --git a/modules/CodeSpecs/ClassSpec.Class.st b/modules/CodeSpecs/ClassSpec.Class.st new file mode 100644 index 00000000..d12eea5f --- /dev/null +++ b/modules/CodeSpecs/ClassSpec.Class.st @@ -0,0 +1,151 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ClassSpec category: #CodeSpecs! +SpeciesSpec subclass: #ClassSpec + instanceVariableNames: 'name supername classVariables sharedPools metaclass variable pointers' + classVariableNames: '' + poolDictionaries: '' + category: 'CodeSpecs'! +!ClassSpec commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +allMethods + ^methods & metaclass methods +! ! + +!ClassSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSuperclassesDo: aBlock + | s | + supername isNil ifTrue: [^self]. + s := self superclass. + s isNil ifTrue: [^self]. + aBlock value: s. + s allSuperclassesDo: aBlock +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +classVariables + ^classVariables +! ! + +!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +classVarNames + ^classVariables keys +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +configureCompiler: aCompiler + +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cvarNames: aCollection + aCollection do: [:cvar | classVariables at: cvar put: nil] +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cvars: aCollection + classVariables := aCollection +! ! + +!ClassSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasMethods + ^super hasMethods or: [metaclass hasMethods] +! ! + +!ClassSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + classVariables := OrderedDictionary new. + sharedPools := OrderedCollection new +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instanceClass + ^self +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPointers + ^pointers +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPointers: aBoolean + pointers := aBoolean +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isVariable + ^variable +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isVariable: aBoolean + variable := aBoolean +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +metaclass + ^metaclass +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +metaclass: aMetaclassSpec + metaclass := aMetaclassSpec +! ! + +!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +metaMethods + ^metaclass methods +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^name +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aString + name := aString +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +sharedPools + ^sharedPools +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +sharedPools: aCollection + sharedPools addAll: aCollection +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +superclass + supername ifNil: [^nil]. + ^module resolveClass: supername +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +supername + ^supername +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +supername: aString + supername := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ClassSpec class' category: #CodeSpecs! +ClassSpec class + instanceVariableNames: ''! + + +ClassSpec initialize! + diff --git a/modules/CodeSpecs/CodeSpecsModule.Class.st b/modules/CodeSpecs/CodeSpecsModule.Class.st new file mode 100644 index 00000000..33d97817 --- /dev/null +++ b/modules/CodeSpecs/CodeSpecsModule.Class.st @@ -0,0 +1,28 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #CodeSpecsModule category: #CodeSpecs! +Module subclass: #CodeSpecsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CodeSpecs'! +!CodeSpecsModule commentStamp: '' prior: 0! + + Copyright (c) 2022, Quorum Software. + See (MIT) license in root directory. +! + +!CodeSpecsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #Kernel -> #(#OrderedDictionary). + } +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CodeSpecsModule class' category: #CodeSpecs! +CodeSpecsModule class + instanceVariableNames: ''! + + diff --git a/modules/CodeSpecs/MetaclassSpec.Class.st b/modules/CodeSpecs/MetaclassSpec.Class.st new file mode 100644 index 00000000..b1f9f771 --- /dev/null +++ b/modules/CodeSpecs/MetaclassSpec.Class.st @@ -0,0 +1,79 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #MetaclassSpec category: #CodeSpecs! +SpeciesSpec subclass: #MetaclassSpec + instanceVariableNames: 'class' + classVariableNames: '' + poolDictionaries: '' + category: 'CodeSpecs'! +!MetaclassSpec commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!MetaclassSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSuperclassesDo: aBlock + | s c | + class supername isNil ifTrue: [ + c := module resolveClass: 'Class'. + c ifNil: [c := Class]. + c allSuperclassesDo: aBlock]. + s := self superclass. + s isNil ifTrue: [^self]. + aBlock value: s. + s allSuperclassesDo: aBlock +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +classVarNames + ^class classVarNames +! ! + +!MetaclassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instanceClass + ^class +! ! + +!MetaclassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instanceClass: aClassSpec + class := aClassSpec +! ! + +!MetaclassSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMetaclass + ^true +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +metaMethods + ^#() +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^class name , ' class' +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +sharedPools + ^class sharedPools +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +superclass + ^class superclass ifNotNil: [:c | c metaclass] +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +supername + ^self superclass name +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MetaclassSpec class' category: #CodeSpecs! +MetaclassSpec class + instanceVariableNames: ''! + + diff --git a/modules/CodeSpecs/MethodSpec.Class.st b/modules/CodeSpecs/MethodSpec.Class.st new file mode 100644 index 00000000..f7f103fc --- /dev/null +++ b/modules/CodeSpecs/MethodSpec.Class.st @@ -0,0 +1,191 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #MethodSpec category: #CodeSpecs! +Object subclass: #MethodSpec + instanceVariableNames: 'selector class source category module ast' + classVariableNames: '' + poolDictionaries: '' + category: 'CodeSpecs'! +!MethodSpec commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!MethodSpec methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! += aMethodSpec + ^aMethodSpec class = self class + and: [aMethodSpec selector == selector] + and: [aMethodSpec classBinding = class] +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asCompiledMethod + self canBeCompiled ifFalse: [^nil]. + ^self + propertyAt: #compiledMethod + ifAbsentPut: [self compiler compileMethod: source] +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +ast + self canBeCompiled ifFalse: [^nil]. + ^ast ifNil: [ast := self compiler parseMethod: source] +! ! + +!MethodSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +bytecodes + ^self canBeCompiled ifTrue: [self asCompiledMethod bytecodes] +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +canBeCompiled + ^self compiler notNil +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +canBeParsed + ^self cannonicalAst notNil +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +cannonicalAst + ^self halt propertyAt: #cannonicalAst ifAbsentPut: [self ast] +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +category + ^self isExtension + ifTrue: ['*' , (module name readStream upToLast: $-)] + ifFalse: [category] +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +category: aString + category := aString +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +classBinding + ^class +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +classBinding: aSpeciesSpec + class := aSpeciesSpec +! ! + +!MethodSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +classname + ^class name +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +equals: aMethodSpec + ^self canBeCompiled + and: [aMethodSpec canBeCompiled] + and: [self isFrameless not] + and: [self isEquivalentTo: aMethodSpec] +! ! + +!MethodSpec methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hash + ^class name hash hashWith: selector +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isEquivalentTo: aMethodSpec + | m1 m2 | + selector == aMethodSpec selector ifFalse: [^false]. + class == aMethodSpec classBinding ifFalse: [^false]. + m1 := self asCompiledMethod. + m1 isNil ifTrue: [^false]. + m2 := aMethodSpec asCompiledMethod. + m2 isNil ifTrue: [^false]. + ^m1 equals: m2 +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isExtension + ^class isExtension +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isFrameless + ^self halt asCompiledMethod isFrameless +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +module + ^module +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +module: aModuleSpec + module := aModuleSpec +! ! + +!MethodSpec methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: class name asString , '>>#' , selector asString +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +referencedIdentifiers + ^self ast ifNil: [#()] ifNotNil: [:node | node identifiers] +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +referencesIdentifier: aString + ^self referencedIdentifiers + anySatisfy: [:identifier | identifier name = aString] +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeFromClass + class removeMethod: self +! ! + +!MethodSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolveClass + ^module resolveClass: class name +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector + ^selector +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector: aSymbol + selector := aSymbol +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +source + ^source +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +source: aString + source := aString. + ast := nil +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +sourceCode + ^source +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesInstanceVariableNamed: aString + ^(self ast variableNamed: aString) notNil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MethodSpec class' category: #CodeSpecs! +MethodSpec class + instanceVariableNames: ''! + + diff --git a/modules/CodeSpecs/ModuleSpec.Class.st b/modules/CodeSpecs/ModuleSpec.Class.st new file mode 100644 index 00000000..5411bc75 --- /dev/null +++ b/modules/CodeSpecs/ModuleSpec.Class.st @@ -0,0 +1,362 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ModuleSpec category: #CodeSpecs! +Object subclass: #ModuleSpec + instanceVariableNames: 'name description classes extendedClasses subclassifiedClasses imports dependencies' + classVariableNames: '' + poolDictionaries: '' + category: 'CodeSpecs'! +!ModuleSpec commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addClass: aClassSpec + classes add: aClassSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addClasses: aCollection + aCollection do: [:c | self addClass: c] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addClassExtension: aClassSpec + extendedClasses add: aClassSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addDependencies: aCollection + aCollection keysAndValuesDo: [:dep :objects | + dependencies + at: dep + put: objects + ifPresent: [:current | (current addAll: objects) withoutDuplicates]] +! ! + +!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +addImport: anAssociation + imports add: anAssociation +! ! + +!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +addImports: aCollection + aCollection do: [:token | self addImport: token asSymbol -> nil] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addSubclassifiedClass: aClassSpec + subclassifiedClasses addIfAbsent: aClassSpec +! ! + +!ModuleSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +allClasses + ^classes , extendedClasses +! ! + +!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +allClassesDo: aBlock + classes do: aBlock. + extendedClasses do: aBlock +! ! + +!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +allMethods + | methods | + methods := OrderedCollection new. + self allMethodsDo: [:m | methods add: m]. + ^methods +! ! + +!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +allMethodsDo: aBlock + self allClassesDo: [:c | + c metaclass methods do: aBlock. + c methods do: aBlock] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +associationAt: aSymbol ifAbsent: aBlock + ^imports associationAt: aSymbol ifAbsent: aBlock +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: aSymbol + ^self at: aSymbol ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: aSymbol ifAbsent: aBlock + | string | + string := aSymbol asString. + classes do: [:c | c name = string ifTrue: [^c]]. + extendedClasses do: [:c | c name = string ifTrue: [^c]]. + subclassifiedClasses do: [:c | c name = string ifTrue: [^c]]. + ^imports at: aSymbol ifAbsent: aBlock +! ! + +!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicResolveClass: aString + classes do: [:c | c name asString = aString ifTrue: [^c]]. + extendedClasses do: [:c | c name asString = aString ifTrue: [^c]]. + subclassifiedClasses do: [:c | c name asString = aString ifTrue: [^c]]. + ^nil +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +classes + ^classes +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cleanDependencies + | needed | + needed := OrderedCollection new. + self methodReferences keys do: [:identifier | needed add: identifier name]. + self hierarchyReferences keys + do: [:identifier | needed add: identifier name]. + extendedClasses do: [:c | needed add: c name]. + dependencies copy keysAndValuesDo: [:module :identifiers | + (identifiers keys anySatisfy: [:identifier | needed includes: identifier]) + ifFalse: [dependencies removeKey: module]] +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +definesClassNamed: aString + ^classes anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:27:39'! +definesGlobal: aString + ^classes anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +dependencies + ^dependencies +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +dependencies: aDictionary + dependencies := aDictionary +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +description + ^description +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +description: aString + description := aString +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +extendedClasses + ^extendedClasses +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +extendsClassNamed: aString + ^extendedClasses anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hierarchyReferences + | references | + references := Dictionary new. + self allClassesDo: [:c | | list | + c superclass ifNotNil: [ + list := references at: c superclass ifAbsentPut: [OrderedCollection new]. + list add: c]]. + ^references +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +includesClass: aClassSpec + ^(self resolveClass: aClassSpec) notNil +! ! + +!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + classes := OrderedCollection new. + extendedClasses := OrderedCollection new. + subclassifiedClasses := OrderedCollection new. + imports := Dictionary new. + dependencies := Dictionary new +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +methodReferences + | references | + references := Dictionary new. + self allMethodsDo: [:m | + m referencedIdentifiers reject: #isLocal thenDo: [:identifier | | list | + list := references at: identifier ifAbsentPut: [OrderedCollection new]. + list add: m]]. + ^references +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^name +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aString + name := aString +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream + nextPut: $<; + print: name; + nextPutAll: '> module' +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +referencedGlobals + | referenced | + referenced := Dictionary new. + self allMethodsDo: [:m | + m referencedIdentifiers + select: [:identifier | | b | + b := identifier binding. + b refersToGlobal or: [b isUnresolved]] + thenDo: [:global | (referenced + at: global name + ifAbsentPut: [OrderedCollection new]) + add: m]]. + ^referenced +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeCategory: aSymbol inClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + class removeCategory: aSymbol +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + classes remove: class ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeEmptyExtensions + extendedClasses copy + reject: #hasMethods + thenDo: [:c | extendedClasses remove: c] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeExtendedClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + extendedClasses remove: class ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeMethod: aMethodSpec + self ASSERT: (self includesClass: aMethodSpec classBinding). + aMethodSpec classBinding removeMethod: aMethodSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSelectors: aCollection + self allClassesDo: [:c | + c removeSelectors: aCollection. + c metaclass removeSelectors: aCollection] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSelectors: aCollection inClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + class removeSelectors: aCollection +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSelectors: aCollection inScope: aClassSpec + | class all | + class := self resolveClass: aClassSpec. + all := self withAllSubclasses: class. + all do: [:c | c removeSelectors: aCollection] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSubclassesOf: aClassSpec + | class | + class := self resolveClass: aClassSpec. + class allSubclasses do: [:c | self removeClass: c; removeExtendedClass: c] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSubclassifiedClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + subclassifiedClasses remove: class ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +requiredImports + | required | + required := Dictionary new. + self referencedGlobals + keysAndValuesDo: [:global :dependents | (self definesGlobal: global) + ifFalse: [required at: global put: dependents]]. + ^required +! ! + +!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolveClass: class + | moniker metaclass found | + moniker := class isString ifTrue: [class] ifFalse: [class name]. + metaclass := moniker endsWith: ' class'. + metaclass ifTrue: [moniker := moniker trimTail: ' class']. + found := self basicResolveClass: moniker. + ^found ifNotNil: [metaclass ifTrue: [found metaclass] ifFalse: [found]] +! ! + +!ModuleSpec methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +sortedClasses + | remaining sorted | + remaining := classes copy. + sorted := OrderedCollection new. + [remaining isEmpty] whileFalse: [| c | + c := remaining first. + (remaining includes: c superclass) + ifTrue: [remaining removeFirst; add: c] + ifFalse: [ + remaining remove: c. + sorted add: c]]. + ^sorted +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +subclassifiesClassNamed: aString + ^subclassifiedClasses anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +withAllSubclasses: aClassSpec + | all | + all := self allClasses. + aClassSpec isMetaclass ifTrue: [all := all collect: #metaclass]. + ^all select: [:c | c withAllSuperclasses includes: aClassSpec] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ModuleSpec class' category: #CodeSpecs! +ModuleSpec class + instanceVariableNames: ''! + + +ModuleSpec initialize! + diff --git a/modules/CodeSpecs/SpeciesSpec.Class.st b/modules/CodeSpecs/SpeciesSpec.Class.st new file mode 100644 index 00000000..ca552494 --- /dev/null +++ b/modules/CodeSpecs/SpeciesSpec.Class.st @@ -0,0 +1,190 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SpeciesSpec category: #CodeSpecs! +Object subclass: #SpeciesSpec + instanceVariableNames: 'instanceVariables methods module format' + classVariableNames: '' + poolDictionaries: '' + category: 'CodeSpecs'! +!SpeciesSpec commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMethod: aMethodSpec + ^methods add: aMethodSpec +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMethods: aCollection + aCollection do: [:m | self addMethod: m] +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +allInstVarNames + ^(self withAllSuperclasses reversed gather: [:c | c instVarNames]) asArray +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSharedPools + | pools | + pools := Set new. + self withAllSuperclasses do: [:c | pools addAll: c sharedPools]. + ^pools +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSubclasses + | all | + all := OrderedCollection new. + self allSubclassesDo: [:cls | all add: cls]. + ^all +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSubclassesDo: aBlock + self subclasses do: [:class | + aBlock value: class. + class allSubclassesDo: aBlock] +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSuperclasses + | superclasses | + superclasses := OrderedCollection new. + self allSuperclassesDo: [:s | superclasses add: s]. + ^superclasses +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +beArrayed + format := format | IsArrayed +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +beBytes + format := format | IsBytes +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasMethods + ^methods notEmpty +! ! + +!SpeciesSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + methods := OrderedCollection new. + instanceVariables := #(). + format := 0 +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instancesAreArrayed + ^format anyMask: IsArrayed +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instancesHavePointers + ^(format anyMask: IsBytes) not +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instVarNames + ^instanceVariables +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instVarNames: aCollection + instanceVariables := aCollection asOrderedCollection +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isExtension + ^module extendedClasses includes: self instanceClass +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMetaclass + ^false +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +ivars: aCollection + instanceVariables := aCollection asOrderedCollection +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +methods + ^methods +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +module: aModuleSpec + module := aModuleSpec +! ! + +!SpeciesSpec methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: '<' , self name , '>' +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeCategory: aSymbol + methods removeAllSuchThat: [:m | m category == aSymbol] +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeMethod: aMethodSpec + methods remove: aMethodSpec ifAbsent: nil +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSelector: aSymbol + methods removeAllSuchThat: [:m | m selector == aSymbol] +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSelectors: aCollection + methods removeAllSuchThat: [:m | aCollection includes: m selector] +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +selectors + ^methods collect: #selector +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +subclasses + ^module allClasses select: [:c | c supername = self name] +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +withAllSubclasses + ^OrderedCollection with: self withAll: self allSubclasses +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +withAllSuperclasses + ^OrderedCollection with: self withAll: self allSuperclasses +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SpeciesSpec class' category: #CodeSpecs! +SpeciesSpec class + instanceVariableNames: ''! + +!SpeciesSpec class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeFormatMasks + self addNamespaceAs: #Format. + Format + at: 'IsArrayed' put: 0x1; + at: 'IsBytes' put: 0x2 +! ! + + +SpeciesSpec initialize! + diff --git a/modules/Compiler/ArgumentBinding.Class.st b/modules/Compiler/ArgumentBinding.Class.st new file mode 100644 index 00000000..1b384018 --- /dev/null +++ b/modules/Compiler/ArgumentBinding.Class.st @@ -0,0 +1,59 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ArgumentBinding category: #'Powerlang-Core-SCompiler-Bindings'! +LocalBinding subclass: #ArgumentBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +beInlined + environment := InlinedArgEnvironment new +! ! + +!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canBeAssigned + ^false +! ! + +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +description + ^'argument ' , name +! ! + +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEncoder + aTreecodeEncoder encodeArgument: index env: environment +! ! + +!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: aNumber + index := aNumber. + +! ! + +!ArgumentBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + environment := ArgumentEnvironment new +! ! + +!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isArgument + ^true +! ! + +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInlined + ^environment isInlinedArgument +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ArgumentBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +ArgumentBinding class + instanceVariableNames: ''! + + +ArgumentBinding initialize! + diff --git a/modules/Compiler/ArgumentEnvironment.Class.st b/modules/Compiler/ArgumentEnvironment.Class.st new file mode 100644 index 00000000..3ec510b0 --- /dev/null +++ b/modules/Compiler/ArgumentEnvironment.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ArgumentEnvironment category: #'Powerlang-Core-SCompiler'! +StackEnvironment subclass: #ArgumentEnvironment + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!ArgumentEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureType + ^CaptureLocalArgument +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ArgumentEnvironment class' category: #'Powerlang-Core-SCompiler'! +ArgumentEnvironment class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/ArrayEnvironment.Class.st b/modules/Compiler/ArrayEnvironment.Class.st new file mode 100644 index 00000000..45a95123 --- /dev/null +++ b/modules/Compiler/ArrayEnvironment.Class.st @@ -0,0 +1,45 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ArrayEnvironment category: #'Powerlang-Core-SCompiler'! +LocalEnvironment subclass: #ArrayEnvironment + instanceVariableNames: 'index' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureType + ^CaptureEnvironmentValue +! ! + +!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^index +! ! + +!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: anInteger + index := anInteger +! ! + +!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCurrent + ^index isNil +! ! + +!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isIndirect + ^self isCurrent not +! ! + +!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isStack + ^false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ArrayEnvironment class' category: #'Powerlang-Core-SCompiler'! +ArrayEnvironment class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/Binding.Class.st b/modules/Compiler/Binding.Class.st new file mode 100644 index 00000000..43d7a59d --- /dev/null +++ b/modules/Compiler/Binding.Class.st @@ -0,0 +1,141 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #Binding category: #'Powerlang-Core-SCompiler-Bindings'! +Object subclass: #Binding + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!Binding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +beReferencedFrom: aScriptNode + +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canBeAssigned + ^true +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +declaration + ^self +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEncoder + self ASSERT: false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isArgument + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isClassBinding + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isClassVariable + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isConstantBinding + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDynamic + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isGlobal + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInStack + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInstVar + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLiteral + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLocal + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isPoolVariableBinding + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSelf + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSelfOrSuper + ^self isSelf or: [self isSuper] +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSuper + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isTemporary + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +literal + ^nil +! ! + +!Binding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^name +! ! + +!Binding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name: aString + name := aString +! ! + +!Binding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printNameOn: aStream + aStream + print: name + +! ! + +!Binding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + self printNameOn: aStream. + aStream + nextPutAll: ' ('. + super printOn: aStream. + aStream nextPutAll: ')' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Binding class' category: #'Powerlang-Core-SCompiler-Bindings'! +Binding class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/BlockScope.Class.st b/modules/Compiler/BlockScope.Class.st new file mode 100644 index 00000000..a723f61e --- /dev/null +++ b/modules/Compiler/BlockScope.Class.st @@ -0,0 +1,241 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #BlockScope category: #'Powerlang-Core-SCompiler'! +ScriptScope subclass: #BlockScope + instanceVariableNames: 'environments captured' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureArgument: anArgumentBinding + | name | + name := anArgumentBinding name. + ^captured at: name ifAbsentPut: [| transferred copy | + transferred := self parent transferLocal: name. + copy := self copyLocal: transferred. + copy declaration: transferred declaration] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureEnvironment: aScriptNode + script == aScriptNode ifTrue: [^self]. + (environments includesIdentical: aScriptNode) ifTrue: [^self]. + self realParent captureEnvironment: aScriptNode. + aScriptNode isMethod + ifTrue: [environments addFirst: aScriptNode] + ifFalse: [environments addLast: aScriptNode] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureLocal: aLocalBinding + (self defines: aLocalBinding name) ifTrue: [^aLocalBinding]. + ^aLocalBinding isTemporary + ifTrue: [self captureTemporary: aLocalBinding] + ifFalse: [self captureArgument: aLocalBinding] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureSelf + captureSelf ifTrue: [^self]. + captureSelf := true. + self parent captureSelf +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureTemporary: aTemporaryBinding + | name | + name := aTemporaryBinding name. + (self defines: name) ifTrue: [^aTemporaryBinding]. + ^captured at: name ifAbsentPut: [| parent declaration transferred copy | + parent := self parent. + declaration := parent scriptDefining: name. + self realScope captureEnvironment: declaration realScript. + transferred := parent transferLocal: name. + copy := self copyLocal: transferred. + copy isInArray ifTrue: [aTemporaryBinding beInArray]. + copy declaration: transferred declaration] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +capturedArguments + ^captured select: [:b | b isArgument] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +capturedEnvironmentIndexOf: aScriptNode + | index | + aScriptNode realScript == script realScript + ifTrue: [ ^ nil ]. + index := environments indexOf: aScriptNode ifAbsent: nil. + self ASSERT: index notNil. + ^self capturesSelf ifTrue: [ index + 1 ] ifFalse: [ index ] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +capturedEnvironments + ^environments +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +capturesHome + ^self home notNil +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +copyLocal: binding + ^script isInlined ifTrue: [binding] ifFalse: [binding copy beInArray] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentIndexOf: aScriptNode + " + temporal compatibility + " + (aScriptNode isKindOf: SScriptNode) + ifFalse: [ self ASSERT: false. ^nil ]. + ^self capturedEnvironmentIndexOf: aScriptNode +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentSizeUpToCapturedArguments + ^self environmentSizeUpToEnvironments + self capturedArguments size +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentSizeUpToEnvironments + | receiver | + receiver := self capturesSelf ifTrue: [ 1 ] ifFalse: [ 0 ]. + ^receiver + environments size +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +environments + " + compatibility, removes the home environment + " + | first | + environments isEmpty ifTrue: [^#()]. + first := environments first. + ^first isMethod ifTrue: [environments allButFirst] ifFalse: [environments] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +home + | first | + environments isEmpty ifTrue: [^nil]. + first := environments first. + ^first isMethod ifTrue: [first] +! ! + +!BlockScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + captured := StaticBinder new. + environments := OrderedCollection new +! ! + +!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +localBindings + ^super localBindings , captured values +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +parent + ^script parent scope +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionCapturedArgument: anArgumentBinding + anArgumentBinding index: self growEnvironment +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionCapturedLocals + script isInlined ifTrue: [^self]. + envSize := self environmentSizeUpToEnvironments. + captured do: [:binding | + binding isArgument + ifTrue: [self positionCapturedArgument: binding] + ifFalse: [self positionCapturedTemporary: binding]] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionCapturedTemporary: aTemporaryBinding + | outest index declaration | + outest := self scriptDefining: aTemporaryBinding name. + index := self capturedEnvironmentIndexOf: outest realScript. + aTemporaryBinding environmentIndex: index. + declaration := outest scope resolve: aTemporaryBinding name. + self ASSERT: declaration index isInteger. + aTemporaryBinding index: declaration index +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionDefinedArgumentsIn: aScriptScope + arguments do: [:binding | | index | + index := binding isInArray + ifTrue: [aScriptScope growEnvironment] + ifFalse: [aScriptScope growStack]. + binding index: index] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionDefinedLocals + | real | + script isInlined + ifTrue: [ + real := self realScope. + self + positionDefinedTemporariesIn: real; + positionDefinedArgumentsIn: real] + ifFalse: [super positionDefinedLocals] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionLocals + self positionCapturedLocals. + super positionLocals +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +realParent + ^script realParent scope +! ! + +!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolve: aString + (self resolveLocal: aString) ifNotNil: [:binding | ^binding]. + ^self parent resolve: aString +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolveLocal: aString + (super resolveLocal: aString) ifNotNil: [:binding | ^binding]. + ^captured at: aString +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +scriptDefining: aString + (self defines: aString) ifTrue: [^script]. + ^self parent scriptDefining: aString +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +transferLocal: name + | binding copy | + (self resolveLocal: name) ifNotNil: [:b | ^b]. + binding := self parent transferLocal: name. + copy := self copyLocal: binding. + captured at: name put: copy. + ^copy +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockScope class' category: #'Powerlang-Core-SCompiler'! +BlockScope class + instanceVariableNames: ''! + + +BlockScope initialize! + diff --git a/modules/Compiler/CompilerModule.Class.st b/modules/Compiler/CompilerModule.Class.st new file mode 100644 index 00000000..74806352 --- /dev/null +++ b/modules/Compiler/CompilerModule.Class.st @@ -0,0 +1,47 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #CompilerModule category: #'Powerlang-Core-LMR'! +Module subclass: #CompilerModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-LMR'! +!CompilerModule commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!CompilerModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + TreecodeEncoder initializeBindingIds; initializeTreecodeIds. + self initializeClosureElementIds +! ! + +!CompilerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! +imports + ^{ + #Kernel -> #(Error ByteArray CompiledBlock Module NumberParser Species OrderedDictionary) + } +! ! + +!CompilerModule methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeClosureElementIds + self namespace + at: #CaptureSelf put: 0; + at: #CaptureLocalArgument put: 1; + at: #CaptureEnvironment put: 2; + at: #CaptureEnvironmentValue put: 3; + at: #CaptureInlinedArgument put: 4 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CompilerModule class' category: #'Powerlang-Core-LMR'! +CompilerModule class + instanceVariableNames: ''! + + +CompilerModule initialize! + diff --git a/modules/Compiler/DynamicBinding.Class.st b/modules/Compiler/DynamicBinding.Class.st new file mode 100644 index 00000000..975f2f62 --- /dev/null +++ b/modules/Compiler/DynamicBinding.Class.st @@ -0,0 +1,51 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #DynamicBinding category: #'Powerlang-Core-SCompiler-Bindings'! +Binding subclass: #DynamicBinding + instanceVariableNames: '' + classVariableNames: 'Default' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beReferencedFrom: aScriptNode + "a dynamic binding could refer to an ivar, so we have to be conservative" + aScriptNode useSelf +! ! + +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeDynamicVar: name +! ! + +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDynamic + ^true +! ! + +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +literal + ^name asSymbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'DynamicBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +DynamicBinding class + instanceVariableNames: 'Default'! + +!DynamicBinding class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +default + ^Default ifNil: [Default := self new name: ''] +! ! + +!DynamicBinding class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +named: aString + | index first second | + index := aString indexOf: $.. + index = 0 ifTrue: [ ^self new name: aString ]. + first := aString copyFrom: 1 to: index - 1. + second := aString copyFrom: index + 1 to: aString size. + ^NestedDynamicBinding new name: { first. second } +! ! + + diff --git a/modules/Compiler/FalseBinding.Class.st b/modules/Compiler/FalseBinding.Class.st new file mode 100644 index 00000000..c883b15d --- /dev/null +++ b/modules/Compiler/FalseBinding.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #FalseBinding category: #'Powerlang-Core-SCompiler-Bindings'! +LiteralBinding subclass: #FalseBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!FalseBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeFalse +! ! + +!FalseBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^'false' +! ! + +!FalseBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FalseBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +FalseBinding class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/IdentifierBinder.Class.st b/modules/Compiler/IdentifierBinder.Class.st new file mode 100644 index 00000000..6961ba1c --- /dev/null +++ b/modules/Compiler/IdentifierBinder.Class.st @@ -0,0 +1,35 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #IdentifierBinder category: #'Powerlang-Core-SCompiler'! +Object subclass: #IdentifierBinder + instanceVariableNames: 'contents' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!IdentifierBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +contents + ^contents +! ! + +!IdentifierBinder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +keyFor: aString + ^self subclassResponsibility +! ! + +!IdentifierBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + self printOn: aStream indent: 0 +! ! + +!IdentifierBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream indent: anInteger + self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IdentifierBinder class' category: #'Powerlang-Core-SCompiler'! +IdentifierBinder class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/InlinedArgEnvironment.Class.st b/modules/Compiler/InlinedArgEnvironment.Class.st new file mode 100644 index 00000000..a5475755 --- /dev/null +++ b/modules/Compiler/InlinedArgEnvironment.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #InlinedArgEnvironment category: #'Powerlang-Core-SCompiler'! +StackEnvironment subclass: #InlinedArgEnvironment + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!InlinedArgEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +captureType + ^CaptureInlinedArgument +! ! + +!InlinedArgEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isInlinedArgument + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlinedArgEnvironment class' category: #'Powerlang-Core-SCompiler'! +InlinedArgEnvironment class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/LiteralBinding.Class.st b/modules/Compiler/LiteralBinding.Class.st new file mode 100644 index 00000000..ef5678a4 --- /dev/null +++ b/modules/Compiler/LiteralBinding.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #LiteralBinding category: #'Powerlang-Core-SCompiler-Bindings'! +Binding subclass: #LiteralBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!LiteralBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLiteral + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LiteralBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +LiteralBinding class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/LocalBinding.Class.st b/modules/Compiler/LocalBinding.Class.st new file mode 100644 index 00000000..e9a15383 --- /dev/null +++ b/modules/Compiler/LocalBinding.Class.st @@ -0,0 +1,80 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #LocalBinding category: #'Powerlang-Core-SCompiler-Bindings'! +Binding subclass: #LocalBinding + instanceVariableNames: 'index environment declaration' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!LocalBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +beInArray + environment := ArrayEnvironment new +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +declaration + ^declaration +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +declaration: anIdentifierNode + declaration := anIdentifierNode +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environment + ^environment index +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentIndex + ^environment index +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentIndex: anInteger + environment index: anInteger +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentObject + ^environment +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentCaptureType + ^environment captureType +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^index +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: aNumber + index := aNumber +! ! + +!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInArray + ^self isInStack not +! ! + +!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInStack + ^environment isStack +! ! + +!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLocal + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LocalBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +LocalBinding class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/LocalEnvironment.Class.st b/modules/Compiler/LocalEnvironment.Class.st new file mode 100644 index 00000000..e4256baa --- /dev/null +++ b/modules/Compiler/LocalEnvironment.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #LocalEnvironment category: #'Powerlang-Core-SCompiler'! +Object subclass: #LocalEnvironment + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: 'ClosureElementTypes' + category: 'Powerlang-Core-SCompiler'! +!LocalEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInlinedArgument + ^false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LocalEnvironment class' category: #'Powerlang-Core-SCompiler'! +LocalEnvironment class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/MessageInliner.Class.st b/modules/Compiler/MessageInliner.Class.st new file mode 100644 index 00000000..85f849ee --- /dev/null +++ b/modules/Compiler/MessageInliner.Class.st @@ -0,0 +1,204 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #MessageInliner category: #'Powerlang-Core-SCompiler'! +Object subclass: #MessageInliner + instanceVariableNames: 'message' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!MessageInliner commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026 13:27:40'! +inline: aMessageNode + | s keywords | + message := aMessageNode. + message receiver isSuper + ifTrue: [ ^ self ]. + message isCascadeMessage + ifTrue: [ ^ self ]. + s := message selector value. + s == #ifTrue: + ifTrue: [ ^ self inlineConditional ]. + s == #ifFalse: + ifTrue: [ ^ self inlineConditional ]. + s == #or: + ifTrue: [ ^ self inlineConditional ]. + s == #and: + ifTrue: [ ^ self inlineConditional ]. + s == #timesRepeat: + ifTrue: [ ^ self inlineConditional ]. + s == #ifTrue:ifFalse: + ifTrue: [ ^ self inlineConditional ]. + s == #ifFalse:ifTrue: + ifTrue: [ ^ self inlineConditional ]. + s == #andNot: + ifTrue: [ ^ self inlineConditional ]. + s == #orNot: + ifTrue: [ ^ self inlineConditional ]. + s == #ifNil: + ifTrue: [ ^ self inlineConditional ]. + s == #ifNotNil: + ifTrue: [ ^ self inlineIfNotNil ]. + s == #ifNil:ifNotNil: + ifTrue: [ ^ self inlineIfNilIfNotNil ]. + s == #ifNotNil:ifNil: + ifTrue: [ ^ self inlineIfNotNilIfNil ]. + s == #whileTrue: + ifTrue: [ ^ self inlineWhile ]. + s == #whileFalse: + ifTrue: [ ^ self inlineWhile ]. + s == #whileTrue + ifTrue: [ ^ self inlineUnitaryWhile ]. + s == #whileFalse + ifTrue: [ ^ self inlineUnitaryWhile ]. + s == #repeat + ifTrue: [ ^ self inlineRepeat ]. + s == #to:do: + ifTrue: [ ^ self inlineToDo ]. + "s == #to:by:do: + ifTrue: [ ^ self inlineToByDo ]." + keywords := $: split: s. + keywords last = '' + ifTrue: [ keywords := keywords allButLast ]. + (keywords conform: [ :k | k = 'and' ]) + ifTrue: [ ^ self inlineConditional ]. + (keywords conform: [ :k | k = 'or' ]) + ifTrue: [ ^ self inlineConditional ]. + ((keywords allButLast conform: [ :k | k = 'and' ]) + and: [ #('ifTrue' 'ifFalse') includes: keywords last ]) + ifTrue: [ ^ self inlineConditional ]. + ((keywords allButLast conform: [ :k | k = 'or' ]) + and: [ #('ifTrue' 'ifFalse') includes: keywords last ]) + ifTrue: [ self inlineConditional ] +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineConditional + | arguments | + arguments := message arguments. + arguments size >= 1 ifFalse: [^self]. + arguments do: [:arg | arg isEvaluable ifFalse: [^self]]. + message beInlined. + arguments select: #isBlockNode thenDo: #beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineIfNilIfNotNil + | arguments arg | + arguments := message arguments. + arguments size = 2 ifFalse: [^self]. + arguments first isEvaluable ifFalse: [^self]. + arg := arguments second. + (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) + ifFalse: [^self]. + message beInlined. + arguments select: #isBlockNode thenDo: #beInlined + +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineIfNotNil + | arguments arg | + arguments := message arguments. + arguments size = 1 ifFalse: [^self]. + arg := arguments first. + (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) + ifFalse: [^self]. + message beInlined. + arg isBlockNode ifTrue: [arg beInlined] +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineIfNotNilIfNil + | arguments arg | + arguments := message arguments. + arguments size = 2 ifFalse: [^self]. + arguments second isEvaluable ifFalse: [^self]. + arg := arguments first. + (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) + ifFalse: [^self]. + message beInlined. + arguments select: #isBlockNode thenDo: #beInlined +! ! + +!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineRepeat + | receiver arguments | + receiver := message receiver. + receiver isEvaluable + ifFalse: [ ^ self ]. + arguments := message arguments. + arguments isEmpty + ifFalse: [ ^ self ]. + receiver isBlockNode + ifFalse: [ ^ self ]. + message beInlined. + receiver beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineToByDo + | arguments arg step | + arguments := message arguments. + arguments size = 3 ifFalse: [^self]. + arg := arguments at: 3. + arg isBlockNode ifFalse: [^self]. + arg arguments size = 1 ifFalse: [^self]. + step := arguments at: 2. + (step isNumberNode and: [step value isSmallInteger]) ifFalse: [^self]. + message beInlined. + arg beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineToDo + | arguments last | + arguments := message arguments. + arguments size = 2 ifFalse: [^self]. + last := arguments at: 2. + last isBlockNode ifFalse: [^self]. + last arguments size = 1 ifFalse: [^self]. + message beInlined. + last beInlined +! ! + +!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineUnitaryWhile + | receiver arguments | + receiver := message receiver. + receiver isEvaluable ifFalse: [^self]. + arguments := message arguments. + arguments size = 0 ifFalse: [^self]. + self inlineConditional. + receiver isBlockNode ifTrue: [ + message beInlined. + receiver beInlined] +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineWhile + | receiver arguments | + receiver := message receiver. + receiver isEvaluable + ifFalse: [ ^ self ]. + arguments := message arguments. + arguments size = 1 + ifFalse: [ ^ self ]. + arguments last isNullary + ifFalse: [ ^ self ]. + self inlineConditional. + receiver isBlockNode + ifTrue: [ receiver beInlined ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MessageInliner class' category: #'Powerlang-Core-SCompiler'! +MessageInliner class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/MethodScope.Class.st b/modules/Compiler/MethodScope.Class.st new file mode 100644 index 00000000..61359d39 --- /dev/null +++ b/modules/Compiler/MethodScope.Class.st @@ -0,0 +1,82 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #MethodScope category: #'Powerlang-Core-SCompiler'! +ScriptScope subclass: #MethodScope + instanceVariableNames: 'pseudo' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!MethodScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureEnvironment: aScriptNode + self ASSERT: aScriptNode == script +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureLocal: aLocalBinding + self ASSERT: (self resolveLocal: aLocalBinding name) notNil. + ^aLocalBinding +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureSelf + captureSelf := true. + +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentIndexOf: aScriptNode + self ASSERT: aScriptNode == script. + ^nil +! ! + +!MethodScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + self initializePseudoVars +! ! + +!MethodScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializePseudoVars + pseudo := StaticBinder new. + pseudo + at: 'nil' put: NilBinding new; + at: 'true' put: TrueBinding new; + at: 'false' put: FalseBinding new; + at: 'self' put: SelfBinding new; + at: 'super' put: SuperBinding new +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolve: aString + (self resolveLocal: aString) ifNotNil: [ :binding | ^ binding ]. + (self resolvePseudo: aString) ifNotNil: [ :binding | ^ binding ]. + ^ DynamicBinding named: aString +! ! + +!MethodScope methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolvePseudo: aString + ^pseudo at: aString + +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +scriptDefining: aString + (self resolveLocal: aString) ifNotNil: [^script]. + self ASSERT: false. + ^nil +! ! + +!MethodScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +transferLocal: name + ^self resolveLocal: name +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MethodScope class' category: #'Powerlang-Core-SCompiler'! +MethodScope class + instanceVariableNames: ''! + + +MethodScope initialize! + diff --git a/modules/Compiler/NestedDynamicBinding.Class.st b/modules/Compiler/NestedDynamicBinding.Class.st new file mode 100644 index 00000000..54d4a12c --- /dev/null +++ b/modules/Compiler/NestedDynamicBinding.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #NestedDynamicBinding category: #'Powerlang-Core-SCompiler-Bindings'! +DynamicBinding subclass: #NestedDynamicBinding + instanceVariableNames: 'parent' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeNestedDynamicVar: name +! ! + +!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +literal + ^name collect: [ :n | n asSymbol] +! ! + +!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printNameOn: aStream + name do: [ :n | aStream nextPutAll: n ] separatedBy: [ aStream nextPut: $. ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NestedDynamicBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +NestedDynamicBinding class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/NilBinding.Class.st b/modules/Compiler/NilBinding.Class.st new file mode 100644 index 00000000..252b919e --- /dev/null +++ b/modules/Compiler/NilBinding.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #NilBinding category: #'Powerlang-Core-SCompiler-Bindings'! +LiteralBinding subclass: #NilBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!NilBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeNil +! ! + +!NilBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +name + ^'nil' +! ! + +!NilBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +value + ^nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NilBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +NilBinding class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SAssignmentNode.Class.st b/modules/Compiler/SAssignmentNode.Class.st new file mode 100644 index 00000000..1e7c9de9 --- /dev/null +++ b/modules/Compiler/SAssignmentNode.Class.st @@ -0,0 +1,74 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SAssignmentNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SAssignmentNode + instanceVariableNames: 'assignees expression operators' + classVariableNames: 'Token' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SAssignmentNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitAssignment: self +! ! + +!SAssignmentNode methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:40'! +assign: anIdentifierNode operator: aDelimiterToken + assignees add: anIdentifierNode. + operators add: aDelimiterToken +! ! + +!SAssignmentNode methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:40'! +assign: anIdentifierNode with: aParseNode operator: aDelimiterToken + assignees add: anIdentifierNode. + operators add: aDelimiterToken. + expression := aParseNode +! ! + +!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +assignees + ^assignees +! ! + +!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +expression + ^expression +! ! + +!SAssignmentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasAssign + ^true +! ! + +!SAssignmentNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + assignees := OrderedCollection new: 1. + operators := OrderedCollection new: 1 +! ! + +!SAssignmentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isAssign + ^true +! ! + +!SAssignmentNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + assignees do: [:v | v nodesDo: aBlock includingDeclarations: aBoolean]. + expression nodesDo: aBlock includingDeclarations: aBoolean +! ! + +!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operators + ^operators +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SAssignmentNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SAssignmentNode class + instanceVariableNames: 'Token'! + + +SAssignmentNode initialize! + diff --git a/modules/Compiler/SBlockNode.Class.st b/modules/Compiler/SBlockNode.Class.st new file mode 100644 index 00000000..a95143bc --- /dev/null +++ b/modules/Compiler/SBlockNode.Class.st @@ -0,0 +1,116 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SBlockNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SScriptNode subclass: #SBlockNode + instanceVariableNames: 'inlined index parent' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SBlockNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitBlock: self +! ! + +!SBlockNode methodsFor: 'emitting - inlined' stamp: 'KenD 28/Jun/2026 13:27:40'! +beInlined + inlined := true. + arguments do: [:arg | arg binding beInlined] +! ! + +!SBlockNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildBlock + | block | + self isInlined ifTrue: [ ^ nil ]. + block := CompiledBlock new. + ^ block + blockNumber: index; + argumentCount: arguments size; + tempCount: scope stackSize; + environmentCount: scope environmentSize; + capturesSelf: scope capturesSelf; + capturesHome: scope capturesHome +! ! + +!SBlockNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureHome + scope captureEnvironment: self ast +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentIndexOf: aParseNode + ^scope environmentIndexOf: aParseNode +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^index +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: aNumber + index := aNumber +! ! + +!SBlockNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + inlined := false. + scope := BlockScope on: self +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBlockNode + ^true +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isEvaluable + ^self isNullary +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInlined + ^inlined +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isNullary + ^arguments isEmpty +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parent + ^parent +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parent: aScriptNode + parent := aScriptNode addChild: self +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +realParent + ^parent realScript +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +realScript + ^inlined ifTrue: [parent realScript] ifFalse: [self] +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +usesHome + ^inlined + ifTrue: [children anySatisfy: [:block | block usesHome]] + ifFalse: [scope capturesHome] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SBlockNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SBlockNode class + instanceVariableNames: ''! + + +SBlockNode initialize! + diff --git a/modules/Compiler/SBraceNode.Class.st b/modules/Compiler/SBraceNode.Class.st new file mode 100644 index 00000000..ccc38bb6 --- /dev/null +++ b/modules/Compiler/SBraceNode.Class.st @@ -0,0 +1,76 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SBraceNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SBraceNode + instanceVariableNames: 'elements message' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SBraceNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitBraceNode: self +! ! + +!SBraceNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +asMessageNode + message notNil ifTrue: [^message]. + ^message := self expanded +! ! + +!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +elements + ^elements +! ! + +!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +elements: aCollection + elements := aCollection asArray +! ! + +!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +expanded + | receiver n new argument array messages i you yourself cascade | + receiver := compiler identifierNode name: 'Array'. + n := elements size. + new := compiler selectorNode symbol: #new:. + argument := compiler numericLiteralNode value: n. + array := compiler messageNode. + array receiver: receiver. + array selector: new. + array arguments: (Array with: argument). + i := 0. + messages := elements collect: [:elem | | msg sel idx args | + i := i + 1. + msg := compiler cascadeMessageNode position: elem position; end: elem end. + sel := compiler selectorNode symbol: #at:put:. + idx := compiler numericLiteralNode value: i. + args := Array with: idx with: elem. + msg selector: sel; arguments: args]. + you := compiler selectorNode symbol: #yourself. + yourself := compiler cascadeMessageNode. + yourself selector: you. + yourself arguments: #(). + messages := messages copyWith: yourself. + cascade := compiler cascadeNode receiver: array. + messages do: [:msg | msg cascade: cascade]. + ^cascade messages: messages +! ! + +!SBraceNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBraceNode + ^true +! ! + +!SBraceNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + elements do: [:n | n nodesDo: aBlock includingDeclarations: aBoolean] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SBraceNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SBraceNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SCascadeMessageNode.Class.st b/modules/Compiler/SCascadeMessageNode.Class.st new file mode 100644 index 00000000..b118b353 --- /dev/null +++ b/modules/Compiler/SCascadeMessageNode.Class.st @@ -0,0 +1,47 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SCascadeMessageNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SMessageNode subclass: #SCascadeMessageNode + instanceVariableNames: 'cascade' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SCascadeMessageNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitCascadeMessage: self +! ! + +!SCascadeMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +cascade: aCascadeNode + cascade := aCascadeNode. + receiver := cascade receiver +! ! + +!SCascadeMessageNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +from: aMessageNode + arguments := aMessageNode arguments. + receiver := aMessageNode receiver. + selector := aMessageNode selector. + inlined := aMessageNode isInlined. + stretch := aMessageNode stretch. + comments := aMessageNode comments +! ! + +!SCascadeMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCascadeMessage + ^true +! ! + +!SCascadeMessageNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + aBlock value: self. + arguments do: [:arg | arg nodesDo: aBlock includingDeclarations: aBoolean] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SCascadeMessageNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SCascadeMessageNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SCascadeNode.Class.st b/modules/Compiler/SCascadeNode.Class.st new file mode 100644 index 00000000..e4e47306 --- /dev/null +++ b/modules/Compiler/SCascadeNode.Class.st @@ -0,0 +1,59 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SCascadeNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SCascadeNode + instanceVariableNames: 'receiver messages optimized' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SCascadeNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitCascade: self +! ! + +!SCascadeNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasAssign + receiver hasAssign ifTrue: [^true]. + messages detect: [:msg | msg hasAssign] ifNone: [^false]. + ^true +! ! + +!SCascadeNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCascade + ^true +! ! + +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +messages + ^messages +! ! + +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +messages: aCollection + messages := aCollection +! ! + +!SCascadeNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + receiver nodesDo: aBlock includingDeclarations: aBoolean. + messages do: [:msg | msg nodesDo: aBlock includingDeclarations: aBoolean] +! ! + +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +receiver + ^receiver +! ! + +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +receiver: rcvr + receiver := rcvr +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SCascadeNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SCascadeNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SCommentNode.Class.st b/modules/Compiler/SCommentNode.Class.st new file mode 100644 index 00000000..db0e6620 --- /dev/null +++ b/modules/Compiler/SCommentNode.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SCommentNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SCommentNode + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SCommentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isComment + ^true +! ! + +!SCommentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^value +! ! + +!SCommentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: aString + value := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SCommentNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SCommentNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SCompilationError.Class.st b/modules/Compiler/SCompilationError.Class.st new file mode 100644 index 00000000..9e7024d5 --- /dev/null +++ b/modules/Compiler/SCompilationError.Class.st @@ -0,0 +1,84 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SCompilationError category: #'Powerlang-Core-SCompiler'! +Error subclass: #SCompilationError + instanceVariableNames: 'compiler resumable retryable stretch' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beFatal + resumable := retryable := false +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beResumable + resumable := true +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beWarning + resumable := true +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler + ^compiler +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler: aCompiler + compiler := aCompiler. + compiler result error: self +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +description: aString + description := aString +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isResumable + ^resumable + +! ! + +!SCompilationError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isUndeclaredAccess + ^false +! ! + +!SCompilationError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isUndeclaredAssignment + ^ false +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +proceed + retryable := false. + compiler result beSuccessful. + self isResumable ifTrue: [ self resume ] ifFalse: [ self return ] +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +source + ^compiler sourceCode copyFrom: stretch start to: stretch end +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stretch + ^stretch +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stretch: aStretch + stretch := aStretch +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SCompilationError class' category: #'Powerlang-Core-SCompiler'! +SCompilationError class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SCompilationResult.Class.st b/modules/Compiler/SCompilationResult.Class.st new file mode 100644 index 00000000..d43fc456 --- /dev/null +++ b/modules/Compiler/SCompilationResult.Class.st @@ -0,0 +1,55 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SCompilationResult category: #'Powerlang-Core-SCompiler'! +Object subclass: #SCompilationResult + instanceVariableNames: 'compiler error ast method' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +ast + ^ast +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +ast: aParseNode + ast := aParseNode +! ! + +!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +beSuccessful + error := nil +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler +! ! + +!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error + ^error +! ! + +!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aCompilationError + error := aCompilationError +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +method + ^method +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +method: aCompiledMethod + method := aCompiledMethod +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SCompilationResult class' category: #'Powerlang-Core-SCompiler'! +SCompilationResult class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SCompiler.Class.st b/modules/Compiler/SCompiler.Class.st new file mode 100644 index 00000000..8a429abe --- /dev/null +++ b/modules/Compiler/SCompiler.Class.st @@ -0,0 +1,120 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SCompiler category: #'Powerlang-Core-SCompiler'! +Object subclass: #SCompiler + instanceVariableNames: 'errorHandler result class' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canBeInIdentifier: aCharacter + ^aCharacter isLetter or: [aCharacter isDigit] or: [aCharacter = $_] +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canStartIdentifier: aCharacter + ^aCharacter isLetter or: [aCharacter = $_] +! ! + +!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +classBinding + ^class +! ! + +!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +classBinding: aSpecies + | instance | + class := aSpecies. + instance := aSpecies instanceClass. + (instance respondsTo: #configureCompiler) + ifTrue: [instance configureCompiler: self] +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +compile: aString + result := self smalltalkCompiler compileMethod: aString. + ^result method +! ! + +!SCompiler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +forClass: aClass + | c | + c := aClass ifNil: [UndefinedObject]. + self classBinding: c +! ! + +!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize: aDictionary + class := aDictionary at: #UndefinedObject ifAbsent: nil +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parse: aString + result := self smalltalkCompiler parseMethod: aString. + ^result ast +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +peekForIdentifier: aStream + | char next | + char := aStream peek. + (self canBeInIdentifier: char) ifTrue: [ + aStream skip: 1. + ^true]. + char = $. ifFalse: [^false]. + aStream prev isLetter ifFalse: [ + aStream skip: 1. + ^false]. + next := aStream skip: 2; peek. + next isNil ifTrue: [ + aStream skip: -1. + ^false]. + ^next isLetter ifFalse: [aStream skip: -1]; yourself +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +protect: aBlock + ^aBlock value +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +smalltalkCompiler + ^ SSmalltalkCompiler new frontend: self +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +smalltalkParser + ^ self smalltalkCompiler parser +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +smalltalkScanner + ^ self smalltalkCompiler scanner +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SCompiler class' category: #'Powerlang-Core-SCompiler'! +SCompiler class + instanceVariableNames: ''! + +!SCompiler class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +compile: aString in: aClass + | compiler | + compiler := self forClass: aClass. + ^compiler compile: aString +! ! + +!SCompiler class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +forClass: aClass + ^self new forClass: aClass +! ! + +!SCompiler class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parse: aString in: aClass + | compiler | + compiler := self forClass: aClass. + ^compiler parse: aString +! ! + + diff --git a/modules/Compiler/SDelimiterToken.Class.st b/modules/Compiler/SDelimiterToken.Class.st new file mode 100644 index 00000000..57550d1e --- /dev/null +++ b/modules/Compiler/SDelimiterToken.Class.st @@ -0,0 +1,45 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SDelimiterToken category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSymbolicToken subclass: #SDelimiterToken + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SDelimiterToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! +asSelectorNode + ^compiler selectorNode symbol: value asString; stretch: stretch +! ! + +!SDelimiterToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +beCharacter + value := value isCharacter ifTrue: [value] ifFalse: [value first] +! ! + +!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +endsExpression + ^value = $. or: [value = $]] or: [value = $)] or: [value = $}] +! ! + +!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isAssignment + ^self is: #':=' +! ! + +!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDelimiter + ^true +! ! + +!SDelimiterToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: aString + super value: aString asSymbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SDelimiterToken class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SDelimiterToken class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SEndToken.Class.st b/modules/Compiler/SEndToken.Class.st new file mode 100644 index 00000000..03d71ef8 --- /dev/null +++ b/modules/Compiler/SEndToken.Class.st @@ -0,0 +1,35 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SEndToken category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SToken subclass: #SEndToken + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SEndToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isEnd + ^true +! ! + +!SEndToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +position: aNumber + super position: aNumber - 1 +! ! + +!SEndToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prevPosition + ^stretch start +! ! + +!SEndToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: aString + '' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SEndToken class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SEndToken class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SFFIDescriptor.Class.st b/modules/Compiler/SFFIDescriptor.Class.st new file mode 100644 index 00000000..1a8853c4 --- /dev/null +++ b/modules/Compiler/SFFIDescriptor.Class.st @@ -0,0 +1,100 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SFFIDescriptor category: #'Powerlang-Core-SCompiler'! +ByteArray subclass: #SFFIDescriptor + instanceVariableNames: '' + classVariableNames: 'FFICallingConventions FFITypes' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! +arguments: aCollection + self replaceFrom: 1 to: aCollection size with: aCollection +! ! + +!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! +callingConvention: anInteger + self at: self size put: anInteger +! ! + +!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! +return: anInteger + self at: self size - 1 put: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SFFIDescriptor class' category: #'Powerlang-Core-SCompiler'! +SFFIDescriptor class + instanceVariableNames: 'FFICallingConventions FFITypes'! + +!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + self initializeFFITypes; initializeCallingConventions +! ! + +!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeCallingConventions + FFICallingConventions := Dictionary new. + FFICallingConventions + at: 'cdecl' put: 20; + at: 'com' put: 21; + at: 'callback' put: 22 +! ! + +!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeFFITypes + FFITypes := Dictionary new. + FFITypes + at: 'uint8' put: 0; + at: 'sint8' put: 1; + at: 'uint16' put: 2; + at: 'sint16' put: 3; + at: 'uint32' put: 4; + at: 'sint32' put: 5; + at: 'uint64' put: 6; + at: 'sint64' put: 7; + + at: 'float' put: 8; + at: 'double' put: 9; + + at: 'uchar' put: 10; + at: 'schar' put: 11; + at: 'ushort' put: 12; + at: 'sshort' put: 13; + at: 'ulong' put: 14; + at: 'slong' put: 15; + at: 'ularge' put: 16; + at: 'large' put: 17; + at: 'longdouble' put: 18; + at: 'pointer' put: 19; + at: 'complex-float' put: 20; + at: 'complex-double' put: 21; + at: 'complex-longdouble' put: 22; + + at: 'void' put: 23 +! ! + +!SFFIDescriptor class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +ret: aString args: aCollection cc: ccName + | args return cc result | + args := aCollection + collect: [ :argname | + FFITypes + at: argname asString + ifAbsent: [ self error: 'undefined argument type ' , argname ] ]. + return := FFITypes + at: aString + ifAbsent: [ self error: 'undefined result type ' , aString ]. + cc := FFICallingConventions + at: ccName + ifAbsent: [ self error: 'unsupported calling convention ' , ccName ]. + result := self new: args size + 2. + ^ result + callingConvention: cc; + return: return; + arguments: args +! ! + + +SFFIDescriptor initialize! + diff --git a/modules/Compiler/SIdentifierNode.Class.st b/modules/Compiler/SIdentifierNode.Class.st new file mode 100644 index 00000000..611b89c5 --- /dev/null +++ b/modules/Compiler/SIdentifierNode.Class.st @@ -0,0 +1,169 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SIdentifierNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SIdentifierNode + instanceVariableNames: 'name binding' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SIdentifierNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitIdentifier: self +! ! + +!SIdentifierNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +beAssigned + | immutable | + binding canBeAssigned ifTrue: [^self]. + immutable := binding isClassBinding + ifTrue: ['class'] + ifFalse: [compiler activeScope describe: binding name]. + self compileError: 'cannot assign to ' , immutable +! ! + +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +binding + ^binding +! ! + +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +binding: aBinding + binding := aBinding +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +checkLowercase + | char | + char := name first. + (char isLetter and: [char isUppercase]) ifFalse: [^self]. + self compileWarning: name storeString , ' should start with lowercase' +! ! + +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +declaration + ^binding declaration +! ! + +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +defineArgumentIn: aScriptScope + binding := aScriptScope defineArgument: name. + binding declaration: self +! ! + +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +defineTemporaryIn: scope + binding := scope defineTemporary: name. + binding declaration: self +! ! + +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + binding := DynamicBinding default +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isEvaluable + ^self isIdentifierLiteral +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isIdentifier + ^true +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isIdentifierLiteral + binding isDynamic ifFalse: [^binding isLiteral]. + ^self ast ifNil: [false] ifNotNil: [:ast | | b | + b := ast scope resolve: name. + b isLiteral] +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isImmediate + ^true +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLocal + ^binding isLocal +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isMethodArgument + | ast | + binding isArgument ifFalse: [^false]. + ast := self ast ifNil: [^false]. + ^ast arguments includes: self declaration +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isMethodTemporary + ^self ast temporaries includes: self declaration +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSelf + ^binding isSelf +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSuper + ^binding isSuper +! ! + +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^name +! ! + +!SIdentifierNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +name: aString + name := aString reduced +! ! + +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + aStream nextPut: $<; + nextPutAll: name; + nextPutAll: '> ('. + super printOn: aStream. + aStream nextPut: $) +! ! + +!SIdentifierNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolveAssigning: aBoolean + binding := compiler activeScope resolve: name. + ^binding + +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sourceIntervals + | stretchs declaration ast string code index | + stretchs := OrderedCollection new. + declaration := binding declaration. + ast := self ast. + ast allNodesDo: [:node | + (node class == self class and: [node binding declaration == declaration]) + ifTrue: [stretchs add: node stretch]]. + string := self source. + code := compiler sourceCode. + index := ast stretch end. + [ + index := code indexOfString: string startingAt: index + 1. + index > 0] + whileTrue: [stretchs add: (index to: index + string size - 1)]. + ^stretchs +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SIdentifierNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SIdentifierNode class + instanceVariableNames: ''! + + +SIdentifierNode initialize! + diff --git a/modules/Compiler/SInvalidPragmaError.Class.st b/modules/Compiler/SInvalidPragmaError.Class.st new file mode 100644 index 00000000..4bf0d6d6 --- /dev/null +++ b/modules/Compiler/SInvalidPragmaError.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SInvalidPragmaError category: #'Powerlang-Core-SCompiler'! +SCompilationError subclass: #SInvalidPragmaError + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SInvalidPragmaError class' category: #'Powerlang-Core-SCompiler'! +SInvalidPragmaError class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SLiteralNode.Class.st b/modules/Compiler/SLiteralNode.Class.st new file mode 100644 index 00000000..e3fa2369 --- /dev/null +++ b/modules/Compiler/SLiteralNode.Class.st @@ -0,0 +1,55 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #SLiteralNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SLiteralNode + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +acceptVisitor: visitor + ^visitor visitLiteral: self +! ! + +!SLiteralNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +beSymbol + value := value asSymbol +! ! + +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +hasSymbol + ^value isSymbol +! ! + +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isEvaluable + ^true +! ! + +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isImmediate + ^true +! ! + +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isLiteral + ^true +! ! + +!SLiteralNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +value + ^value +! ! + +!SLiteralNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +value: anObject + value := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SLiteralNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SLiteralNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SMessageNode.Class.st b/modules/Compiler/SMessageNode.Class.st new file mode 100644 index 00000000..055933ac --- /dev/null +++ b/modules/Compiler/SMessageNode.Class.st @@ -0,0 +1,129 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SMessageNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SMessageNode + instanceVariableNames: 'selector receiver arguments inlined' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SMessageNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitMessage: self +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arguments + ^arguments +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arguments: aCollection + arguments := aCollection +! ! + +!SMessageNode methodsFor: 'emitting - inlined' stamp: 'KenD 28/Jun/2026 13:27:40'! +beInlined + inlined := true +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasAssign + receiver hasAssign ifTrue: [^true]. + ^arguments anySatisfy: [:arg | arg hasAssign] +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasVolatileArguments + ^arguments anySatisfy: [:arg | + arg isIdentifier + ifTrue: [arg binding canBeAssigned] + ifFalse: [arg isBlockNode not andNot: [arg isLiteral]]] +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasVolatileReceiver + ^ compiler hasBlocks + or: [ receiver isMethodTemporary not ] + or: [ arguments anySatisfy: [ :arg | arg hasAssign ] ] +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + inlined := false +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCascadeMessage + ^false +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInlined + ^inlined +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isMessageNode + ^true +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +needsStrictEvaluationOrder + arguments size = 0 ifTrue: [^false]. + receiver isBlockNode ifTrue: [^false]. + receiver isLiteral ifTrue: [^false]. + receiver isSelf ifTrue: [^false]. + receiver isSuper ifTrue: [^false]. + receiver isMethodArgument ifTrue: [^false]. + self hasVolatileReceiver ifFalse: [^false]. + (receiver isImmediate + and: [arguments conform: [:arg | arg isImmediate or: [arg isBlockNode]]]) + ifTrue: [^false]. + receiver hasAssign ifTrue: [^true]. + receiver isMessageNode ifTrue: [ ^true ]. + ^self hasVolatileArguments +! ! + +!SMessageNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + receiver nodesDo: aBlock includingDeclarations: aBoolean. + arguments do: [:arg | arg nodesDo: aBlock includingDeclarations: aBoolean]. + selector nodesDo: aBlock includingDeclarations: aBoolean +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +receiver + ^receiver +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +receiver: node + receiver := node +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +selector + ^selector +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +selector: node + selector := node +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +symbol + ^selector symbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SMessageNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SMessageNode class + instanceVariableNames: ''! + + +SMessageNode initialize! + diff --git a/modules/Compiler/SMethodNode.Class.st b/modules/Compiler/SMethodNode.Class.st new file mode 100644 index 00000000..e97979f9 --- /dev/null +++ b/modules/Compiler/SMethodNode.Class.st @@ -0,0 +1,174 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #SMethodNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SScriptNode subclass: #SMethodNode + instanceVariableNames: 'selector pragma' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SMethodNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:41'! +acceptVisitor: visitor + ^visitor visitMethod: self +! ! + +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +buildMethod + | cm encoder treecodes | + cm := self methodClass withAll: self literals. + cm + blockCount: compiler blockCount; + tempCount: scope stackSize; + argumentCount: arguments size; + environmentCount: scope environmentSize; + capturesSelf: scope capturesSelf; + hasEnvironment: self needsEnvironment; + hasFrame: self needsFrame; + selector: self selector; + sourceObject: compiler sourceCode; + classBinding: compiler frontend classBinding. + cm pragma: pragma. + cm blocks do: [ :block | block method: cm ]. + encoder := TreecodeEncoder new method: cm. + treecodes := self acceptVisitor: encoder. + ^ cm treecodes: treecodes +! ! + +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +captureHome + +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +compiler: aSmalltalkCompiler + super compiler: aSmalltalkCompiler. + scope := MethodScope new script: self. + pragma := aSmalltalkCompiler pragmaNode +! ! + +!SMethodNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +environmentIndexOf: aParseNode + ^nil +! ! + +!SMethodNode methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:41'! +header + " + (Object >> #printOn:) ast header + " + | interval | + interval := selector stretch. + arguments notEmpty + ifTrue: [interval := interval start thru: arguments last stretch end]. + ^compiler sourceCode copyFrom: interval start to: interval end +! ! + +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isHeadless + ^selector isNil +! ! + +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isMethod + ^true +! ! + +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +literals + | literals v l | + literals := OrderedCollection new. + pragma isUsed + ifTrue: [ literals add: pragma name ]. + self + nodesDo: [ :n | + n isLiteral + ifTrue: [ v := n value. + v isSmallInteger + ifFalse: [ literals add: v ] ]. + n isMessageNode + ifTrue: [ literals add: n symbol ]. + n isBraceNode + ifTrue: [ n isLiteral + ifTrue: [ self halt ] + ifFalse: [ literals + add: #Array; + add: #new:; + add: #at:put:; + add: #yourself ] ]. + (n isIdentifier + and: [ l := n binding literal. + l notNil ]) + ifTrue: [ literals add: l ]. + (n isBlockNode andNot: [ n isInlined ]) + ifTrue: [ literals add: n buildBlock ] ]. + ^ literals withoutDuplicates +! ! + +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +methodClass + | type | + type := pragma type. + type = #callback + ifTrue: [ ^ CallbackMethod ]. + type = #callout + ifTrue: [ ^ CalloutMethod ]. + ^ CompiledMethod +! ! + +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +needsEnvironment + ^scope environmentSize > 0 + or: [children anySatisfy: [:block | block usesHome]] +! ! + +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +needsFrame + scope stackSize > 0 ifTrue: [ ^ true ]. + arguments size > 16 ifTrue: [ ^ true ]. + compiler hasSends ifTrue: [ ^ true ]. + compiler hasBlocks ifTrue: [ ^ true ]. + ^ false +! ! + +!SMethodNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + (aBoolean and: [selector notNil]) ifTrue: [aBlock value: selector] +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +pragma + ^pragma +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +pragma: anObject + pragma := anObject +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +realScript + ^self +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +selector + ^selector value +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +selector: aSelectorNode + selector := aSelectorNode +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +selectorNode + ^selector +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SMethodNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SMethodNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SNumberNode.Class.st b/modules/Compiler/SNumberNode.Class.st new file mode 100644 index 00000000..06e647a9 --- /dev/null +++ b/modules/Compiler/SNumberNode.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SNumberNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SLiteralNode subclass: #SNumberNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SNumberNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitNumberNode: self +! ! + +!SNumberNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isNumberNode + ^true +! ! + +!SNumberNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +negate + value := value negated +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SNumberNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SNumberNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SParseNode.Class.st b/modules/Compiler/SParseNode.Class.st new file mode 100644 index 00000000..f987182d --- /dev/null +++ b/modules/Compiler/SParseNode.Class.st @@ -0,0 +1,140 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #SParseNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SToken subclass: #SParseNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SParseNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:41'! +acceptVisitor: visitor + ^visitor visitParseNode: self +! ! + +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +allNodesDo: aBlock + self nodesDo: aBlock includingDeclarations: true +! ! + +!SParseNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +ast + ^compiler ast +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +hasAssign + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isAssign + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isBraceNode + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isCascade + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isCascadeMessage + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isEvaluable + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isImmediate + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isMessageNode + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isMethod + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isMethodArgument + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isMethodTemporary + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isReturn + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isSelector + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isSelf + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isSuper + ^false +! ! + +!SParseNode methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:41'! +moveCommentsFrom: aParseNode + aParseNode moveCommentsTo: self +! ! + +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +nodeWithLiteral: anObject + ^self nodesDetect: [:n | (n isLiteral or: [n isSelector]) and: [n value = anObject]] ifAbsent: nil + +! ! + +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +nodesDetect: aBlock ifAbsent: absentBlock + self nodesDo: [:node | (aBlock value: node) ifTrue: [ ^node ] ] includingDeclarations: false. + ^absentBlock value +! ! + +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +nodesDo: aBlock + self nodesDo: aBlock includingDeclarations: false +! ! + +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +nodesDo: aBlock includingDeclarations: aBoolean + aBlock value: self +! ! + +!SParseNode methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:41'! +variableNamed: aString + self + allNodesDo: [:node | (node isIdentifier and: [node name = aString]) + ifTrue: [^node]]. + ^nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SParseNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SParseTreeVisitor.Class.st b/modules/Compiler/SParseTreeVisitor.Class.st new file mode 100644 index 00000000..2da8e5c1 --- /dev/null +++ b/modules/Compiler/SParseTreeVisitor.Class.st @@ -0,0 +1,105 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SParseTreeVisitor category: #'Powerlang-Core-SCompiler'! +Object subclass: #SParseTreeVisitor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visit: aParseNode + ^aParseNode notNil ifTrue: [aParseNode acceptVisitor: self] +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitAssignment: anAssignmentNode + ^self visitParseNode: anAssignmentNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBlock: aBlockNode + ^self visitParseNode: aBlockNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBraceNode: aBraceNode + ^self visitParseNode: aBraceNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascade: aCascadeNode + ^self visitParseNode: aCascadeNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascadeMessage: aCascadeMessageNode + ^self visitMessage: aCascadeMessageNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitForeignNode: anForeignNode + self visitLiteral: anForeignNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitIdentifier: anIdentifierNode + ^self visitParseNode: anIdentifierNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitLiteral: aLiteralNode + ^self visitParseNode: aLiteralNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMessage: aMessageNode + ^self visitParseNode: aMessageNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMethod: aMethodNode + ^self visitParseNode: aMethodNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitNumberNode: aNumberNode + ^self visitLiteral: aNumberNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitParseNode: aParseNode + ^self subclassResponsibility +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitPragma: aPragmaNode + ^self visitParseNode: aPragmaNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitReturn: aReturnNode + ^self visitParseNode: aReturnNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitSelector: aSelectorNode + ^self visitParseNode: aSelectorNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitString: aStringNode + ^self visitLiteral: aStringNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitSymbolicPragma: aPragmaNode + ^self visitPragma: aPragmaNode +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SParseTreeVisitor class' category: #'Powerlang-Core-SCompiler'! +SParseTreeVisitor class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SPragmaNode.Class.st b/modules/Compiler/SPragmaNode.Class.st new file mode 100644 index 00000000..7a69682d --- /dev/null +++ b/modules/Compiler/SPragmaNode.Class.st @@ -0,0 +1,63 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SPragmaNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SToken subclass: #SPragmaNode + instanceVariableNames: 'type name info' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: aVisitor + self isFFI ifTrue: [^aVisitor visitFFIPragma: self]. + self isPrimitive ifTrue: [^aVisitor visitPrimitivePragma: self]. + self isSymbolic ifTrue: [^aVisitor visitSymbolicPragma: self] +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffi: cc name: aString with: anFFIDescriptor + type := cc. + name := aString. + info := anFFIDescriptor +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffi: aString with: anFFIDescriptor + type := #ffi. + name := aString. + info := anFFIDescriptor +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +info + ^info +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +isUsed + ^type notNil +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^name +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +primitive: anInteger name: aString + type := #primitive. + name := aString. + info := anInteger +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +type + ^type +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SPragmaNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SPragmaNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SReturnNode.Class.st b/modules/Compiler/SReturnNode.Class.st new file mode 100644 index 00000000..42e30542 --- /dev/null +++ b/modules/Compiler/SReturnNode.Class.st @@ -0,0 +1,51 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SReturnNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SReturnNode + instanceVariableNames: 'expression return' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SReturnNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitReturn: self +! ! + +!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +expression + ^expression +! ! + +!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +expression: node + expression := node +! ! + +!SReturnNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasAssign + ^expression hasAssign +! ! + +!SReturnNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isReturn + ^true +! ! + +!SReturnNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + expression nodesDo: aBlock includingDeclarations: aBoolean +! ! + +!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +return: aSmalltalkToken + return := aSmalltalkToken +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SReturnNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SReturnNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SScriptNode.Class.st b/modules/Compiler/SScriptNode.Class.st new file mode 100644 index 00000000..785856c9 --- /dev/null +++ b/modules/Compiler/SScriptNode.Class.st @@ -0,0 +1,127 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SScriptNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SScriptNode + instanceVariableNames: 'statements arguments temporaries children scope' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SScriptNode methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:40'! +addChild: aBlockNode + children add: aBlockNode +! ! + +!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +addStatements: anOrderedCollection + statements addAll: anOrderedCollection +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arguments + ^arguments +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arguments: aCollection + arguments := aCollection +! ! + +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +bindLocals + arguments do: [:arg | arg defineArgumentIn: scope]. + temporaries do: [:temp | temp checkLowercase; defineTemporaryIn: scope]. + children do: [:block | block bindLocals] +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +children + ^children +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentSize + ^scope environmentSize +! ! + +!SScriptNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasAssign + statements do: [:s | s hasAssign ifTrue: [^true]]. + ^false +! ! + +!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +identifiers + | result | + result := OrderedCollection new. + self nodesDo: [:node | node isIdentifier ifTrue: [result add: node]]. + ^result withoutDuplicates +! ! + +!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + statements := OrderedCollection new. + arguments := #(). + temporaries := #(). + children := OrderedCollection new +! ! + +!SScriptNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + aBoolean ifTrue: [ + arguments do: [:a | a nodesDo: aBlock includingDeclarations: aBoolean]. + temporaries do: [:a | a nodesDo: aBlock includingDeclarations: aBoolean]]. + statements do: [:s | s nodesDo: aBlock includingDeclarations: aBoolean] +! ! + +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionLocals + scope positionLocals. + children do: [:b | b positionLocals] +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +realScript + self subclassResponsibility +! ! + +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +reference: aBinding + aBinding beReferencedFrom: self +! ! + +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +scope + ^scope +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +statements + ^statements +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaries + ^temporaries +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaries: aCollection + temporaries := aCollection +! ! + +!SScriptNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +useSelf + scope captureSelf +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SScriptNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SScriptNode class + instanceVariableNames: ''! + + +SScriptNode initialize! + diff --git a/modules/Compiler/SSelectorNode.Class.st b/modules/Compiler/SSelectorNode.Class.st new file mode 100644 index 00000000..70075564 --- /dev/null +++ b/modules/Compiler/SSelectorNode.Class.st @@ -0,0 +1,72 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #SSelectorNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SSelectorNode + instanceVariableNames: 'symbol keywords' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SSelectorNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:41'! +acceptVisitor: visitor + ^visitor visitSelector: self +! ! + +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +addKeyword: aSelectorNode + keywords isNil ifTrue: [keywords := OrderedCollection new: 1]. + keywords add: aSelectorNode +! ! + +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +end + stretch end ifNotNil: [:e | ^e]. + ^keywords notNil ifTrue: [keywords last end] +! ! + +!SSelectorNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +hasSymbol + ^symbol isSymbol +! ! + +!SSelectorNode methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:41'! +isBinary + ^symbol isBinary +! ! + +!SSelectorNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isSelector + ^true +! ! + +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +keywords + ^keywords isNil ifTrue: [{self}] ifFalse: [keywords] +! ! + +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +positions + ^self keywords collect: [:node | node position] +! ! + +!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +symbol + ^symbol +! ! + +!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +symbol: aString + symbol := aString asSymbol +! ! + +!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +value + ^symbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SSelectorNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSelectorNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SSemanticVisitor.Class.st b/modules/Compiler/SSemanticVisitor.Class.st new file mode 100644 index 00000000..f6af1140 --- /dev/null +++ b/modules/Compiler/SSemanticVisitor.Class.st @@ -0,0 +1,133 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SSemanticVisitor category: #'Powerlang-Core-SCompiler'! +SParseTreeVisitor subclass: #SSemanticVisitor + instanceVariableNames: 'inliner' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeAssignment: anAssignmentNode + anAssignmentNode assignees + do: [:v | self analyzeIdentifier: v assignee: true] +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeBlock: aBlockNode while: aBlock + aBlockNode isInlined + ifFalse: [aBlockNode index: aBlockNode compiler blockIndex]. + self analyzeScript: aBlockNode while: aBlock +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeIdentifier: anIdentifierNode + self analyzeIdentifier: anIdentifierNode assignee: false +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeIdentifier: anIdentifierNode assignee: aBoolean + | script binding | + anIdentifierNode resolveAssigning: aBoolean. + aBoolean ifTrue: [anIdentifierNode beAssigned]. + script := anIdentifierNode compiler activeScript. + binding := anIdentifierNode binding. + script reference: binding. + binding isLocal ifTrue: [binding := script scope captureLocal: binding]. + anIdentifierNode binding: binding +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeMessage: aMessageNode + inliner inline: aMessageNode. + aMessageNode isInlined ifFalse: [aMessageNode compiler noticeSend] +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeMethod: aMethodNode while: aBlock + self analyzeScript: aMethodNode while: aBlock +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeReturn: aReturnNode + aReturnNode compiler activeScript realScript captureHome +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeScript: aScriptNode while: aBlock + aScriptNode compiler activate: aScriptNode while: aBlock +! ! + +!SSemanticVisitor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + inliner := MessageInliner new +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitAssignment: anAssignmentNode + self analyzeAssignment: anAssignmentNode. + anAssignmentNode expression acceptVisitor: self +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBlock: aBlockNode + self + analyzeBlock: aBlockNode + while: [aBlockNode statements do: [:node | node acceptVisitor: self]] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBraceNode: aBraceNode + aBraceNode isLiteral + ifFalse: [aBraceNode asMessageNode acceptVisitor: self] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascade: aCascadeNode + aCascadeNode receiver acceptVisitor: self. + aCascadeNode messages do: [:msg | msg acceptVisitor: self] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitIdentifier: anIdentifierNode + self analyzeIdentifier: anIdentifierNode +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMessage: aMessageNode + self analyzeMessage: aMessageNode. + aMessageNode receiver acceptVisitor: self. + aMessageNode arguments do: [:arg | arg acceptVisitor: self] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMethod: aMethodNode + self analyzeMethod: aMethodNode while: [ + aMethodNode bindLocals. + aMethodNode statements do: [:s | s acceptVisitor: self]. + aMethodNode positionLocals] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitParseNode: aParseNode + " + do nothing + " + +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitReturn: aReturnNode + aReturnNode expression acceptVisitor: self. + self analyzeReturn: aReturnNode +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SSemanticVisitor class' category: #'Powerlang-Core-SCompiler'! +SSemanticVisitor class + instanceVariableNames: ''! + + +SSemanticVisitor initialize! + diff --git a/modules/Compiler/SSmalltalkCompiler.Class.st b/modules/Compiler/SSmalltalkCompiler.Class.st new file mode 100644 index 00000000..ef4cb105 --- /dev/null +++ b/modules/Compiler/SSmalltalkCompiler.Class.st @@ -0,0 +1,295 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SSmalltalkCompiler category: #'Powerlang-Core-SCompiler-Smalltalk'! +Object subclass: #SSmalltalkCompiler + instanceVariableNames: 'frontend source ast result headless blocks leaf activeScript' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk'! +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +activate: aScriptNode while: aBlock + | current | + current := activeScript. + activeScript := aScriptNode. + aBlock value. + activeScript := current +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +activeScope + ^activeScript scope +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +activeScript + ^activeScript +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +activeScript: aParseNode + activeScript := aParseNode +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +assignmentNode + ^SAssignmentNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +ast + ^ast +! ! + +!SSmalltalkCompiler methodsFor: 'emitting' stamp: 'KenD 28/Jun/2026 13:27:40'! +blockCount + ^blocks +! ! + +!SSmalltalkCompiler methodsFor: 'emitting' stamp: 'KenD 28/Jun/2026 13:27:40'! +blockIndex + blocks := blocks + 1. + ^blocks - 1 +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +blockNode + ^SBlockNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +braceNode + ^SBraceNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildMethod + result method: ast buildMethod +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +cascadeMessageNode + ^SCascadeMessageNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +cascadeNode + ^SCascadeNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +commentNode + ^SCommentNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +compilationError: aString stretch: aStretch + ^SCompilationError new + compiler: self; + stretch: aStretch; + description: aString +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +compileMethod: aString + source := aString. + frontend protect: [ + self + parseMethod; + resolveSemantics; + buildMethod]. + ^result +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +delimiterToken + ^SDelimiterToken new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +endToken + ^SEndToken new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString at: anInteger + | stretch | + stretch := anInteger thru: anInteger. + ^self error: aString stretch: stretch +! ! + +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString stretch: aStretch + | error | + error := self compilationError: aString stretch: aStretch. + ^error beFatal; signal +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +frontend + ^frontend +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +frontend: aCompiler + frontend := aCompiler +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasBlocks + ^ blocks > 0 +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasSends +^ leaf not +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +identifierNode + ^SIdentifierNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + self reset + +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +literalNode + ^SLiteralNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +messageNode + ^SMessageNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodNode + ^SMethodNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +noticeSend + leaf := false +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +numericLiteralNode + ^SNumberNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseFragment + headless := false. + self reset. + ast := self parser methodFragment. + result ast: ast +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseFragment: aString + source := aString. + [self parseFragment; resolveSemantics] on: SCompilationError do: []. + ^ast +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseMethod + headless := false. + self reset. + ast := self parser method. + result ast: ast +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseMethod: aString + source := aString. + frontend protect: [self parseMethod; resolveSemantics]. + ^result +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parser + ^SSmalltalkParser new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +pragmaNode + ^SPragmaNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +reset + self resetResult. + leaf := true. + blocks := 0. +! ! + +!SSmalltalkCompiler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +resetResult + result := SCompilationResult new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolveSemantics + ast acceptVisitor: SSemanticVisitor new +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +result + ^result +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +returnNode + ^SReturnNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +scanner + ^SSmalltalkScanner new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +selectorNode + ^SSelectorNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sourceCode + ^source +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sourceCode: aString + source := aString +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +stringToken + ^SStringToken new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +supportsBraceNodes + ^true +! ! + +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +warning: aString at: aStretch + | error | + error := self compilationError: aString stretch: aStretch. + error beWarning; signal +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SSmalltalkCompiler class' category: #'Powerlang-Core-SCompiler-Smalltalk'! +SSmalltalkCompiler class + instanceVariableNames: ''! + + +SSmalltalkCompiler initialize! + diff --git a/modules/Compiler/SSmalltalkParser.Class.st b/modules/Compiler/SSmalltalkParser.Class.st new file mode 100644 index 00000000..1273751b --- /dev/null +++ b/modules/Compiler/SSmalltalkParser.Class.st @@ -0,0 +1,905 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SSmalltalkParser category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +Object subclass: #SSmalltalkParser + instanceVariableNames: 'compiler scanner token next' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addBodyTo: aMethodNode + self + addTemporariesTo: aMethodNode; + addPragmaTo: aMethodNode; + addStatementsTo: aMethodNode +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +addByteTo: aCollection + | byte | + byte := token isLiteral ifTrue: [token value] ifFalse: [token literalValue]. + byte isInteger ifFalse: [self nonIntegerToken]. + (byte between: 0 and: 255) ifFalse: [self invalidByteValue]. + aCollection add: byte +! ! + +!SSmalltalkParser methodsFor: 'api support' stamp: 'KenD 28/Jun/2026 13:27:40'! +addPragmaTo: aMethodNode + (self attachPragmaTo: aMethodNode) ifTrue: [self step] +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addStatementsTo: aMethodNode + aMethodNode + position: token position; + addStatements: self statements; + end: token position; + moveCommentsFrom: token. + token isEnd + ifFalse: [^self unexpectedStatementError: aMethodNode statements] +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addTemporariesTo: aMethodNode + aMethodNode temporaries: self temporaries +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +arrayBody + | literals position | + literals := OrderedCollection new. + position := token position. + [ + self step. + (token is: $)) or: [token isEnd]] + whileFalse: [| element | + element := self arrayElement. + literals add: element]. + token isEnd ifTrue: [self missingToken: ')']. + ^self buildNode: compiler literalNode at: position with: literals asArray +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +arrayElement + token isLiteral ifTrue: [^token value]. + token isNameToken ifTrue: [^self pseudoLiteralValue]. + token isKeyword ifTrue: [^self literalKeyword]. + (token is: #'-') ifTrue: [^self negativeNumberOrBinary]. + token hasSymbol ifTrue: [^token value]. + (token is: $() ifTrue: [^self arrayBody value]. + (token is: #'#(') ifTrue: [^self arrayBody value]. + (token is: #'#[') ifTrue: [^self byteArrayBody value]. + self invalidArrayToken +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +assignment + | position variable delimiter expression assignment | + position := token position. + variable := self step asIdentifierNode moveCommentsFrom: token. + delimiter := self step. + expression := self expression. + expression isAssign + ifTrue: [^expression assign: variable operator: delimiter]. + expression moveCommentsFrom: token. + assignment := self buildNode: compiler assignmentNode at: position. + ^assignment assign: variable with: expression operator: delimiter +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +attachPragmaTo: aMethodNode + | start pragma | + (aMethodNode isHeadless orNot: [token is: #'<']) ifTrue: [^false]. + start := token position. + self step. + pragma := token isKeyword + ifTrue: [self ffiOrPrimitive: aMethodNode] + ifFalse: [self symbolicPragma]. + pragma position: start; end: token position. + aMethodNode pragma: pragma. + (token is: #'>') ifFalse: [self missingToken: '>']. + ^true +! ! + +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! +binaryMessage: aMessageNode + | selector primary argument | + selector := self step. + primary := self primary. + primary isNil ifTrue: [ + ((selector is: $:) and: [token is: #'=']) + ifTrue: [self + error: 'stray whitespaces left in assignment' + at: token position - 1] + ifFalse: [self error: 'primary missing']]. + argument := self unarySequence: primary. + aMessageNode + selector: selector asSelectorNode; + end: argument end; + arguments: {argument} +! ! + +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! +binarySequence: aParseNode + | node rcvr | + node := aParseNode. + [ + rcvr := node. + self hasBinarySelector] + whileTrue: [ + node := self buildMessageNode: rcvr. + self binaryMessage: node]. + ^node +! ! + +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! +binarySignature + | selector arguments | + ((token isStringToken and: [token hasSymbol]) + or: [token is: $^] + or: [token is: $:]) + ifFalse: [^nil]. + selector := self step asSelectorNode. + token isNameToken ifFalse: [self missingArgument]. + self validateLocalName: token. + arguments := {token asIdentifierNode}. + self step. + token moveCommentsTo: selector. + ^self buildMethodNode: selector arguments: arguments +! ! + +!SSmalltalkParser methodsFor: 'blocks' stamp: 'KenD 28/Jun/2026 13:27:40'! +block + | block | + block := self buildNode: compiler blockNode at: token position. + block parent: compiler activeScript. + compiler activate: block while: [ + token moveCommentsTo: block. + self step. + block + arguments: self blockArguments; + temporaries: self temporaries; + addStatements: self statements. + (token is: $]) ifFalse: [self missingToken: ']']. + block end: token position. + token moveCommentsTo: block. + self step]. + ^block +! ! + +!SSmalltalkParser methodsFor: 'blocks' stamp: 'KenD 28/Jun/2026 13:27:40'! +blockArguments + | arguments | + (token is: $:) ifFalse: [^#()]. + arguments := OrderedCollection new. + [ + self step. + token isNameToken ifFalse: [self missingArgument]. + self validateLocalName: token. + arguments add: self step asIdentifierNode. + token is: $:] whileTrue. + token isBar ifTrue: [self step] ifFalse: [ + (token is: #'||') + ifTrue: [token value: #'|'] + ifFalse: [self missingToken: '|']]. + ^arguments +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +braceBody + | elements position | + elements := OrderedCollection new. + position := token position. + self step. + [ + token isEnd ifTrue: [self missingToken: '}']. + token is: $}] + whileFalse: [ + elements add: self expression. + (token is: $.) ifTrue: [self step]]. + ^self buildBraceNode: elements at: position +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +bracedArray + | array | + array := self braceBody. + self step. + ^array +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildBraceNode: elements at: position + | node | + node := self buildNode: compiler braceNode at: position. + ^node elements: elements +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildCascadeMessageNode: receiver + | node | + node := self buildNode: compiler cascadeMessageNode at: receiver position. + ^node receiver: receiver +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildMessageNode: receiver + | node | + node := self buildNode: compiler messageNode at: receiver position. + ^node receiver: receiver +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildMethodNode: selector arguments: arguments + | node | + node := self buildNode: compiler methodNode at: selector position. + compiler activeScript: node. + ^node selector: selector; arguments: arguments +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildNode: aParserNode at: anInteger + ^aParserNode position: anInteger; end: token position +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildNode: aParseNode at: anInteger with: anObject + | node | + node := scanner buildToken: aParseNode at: anInteger with: anObject. + ^node end: token position +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +byteArrayBody + | bytes save start array node | + bytes := OrderedCollection new. + save := token. + start := token position. + [ + self step. + token isLiteral or: [token isPoolLiteral]] + whileTrue: [self addByteTo: bytes]. + (token is: $]) ifFalse: [ + token isNameToken + ifTrue: [self missingLiteral] + ifFalse: [self missingToken: ']']]. + array := ByteArray new: bytes size. + bytes withIndexDo: [:b :i | array at: i put: b]. + node := self buildNode: compiler literalNode at: start with: array. + ^node moveCommentsFrom: save +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +cascadeMessage: aMessageNode + | msg | + self hasUnarySelector ifTrue: [^self unaryMessage: aMessageNode]. + self hasBinarySelector ifTrue: [^self binaryMessage: aMessageNode]. + self hasKeywordSelector ifTrue: [^self keywordMessage: aMessageNode]. + msg := token value = '' + ifTrue: ['unfinished cascade'] + ifFalse: [token value asString , ' not allowed in cascade']. + self error: msg +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +cascadeSequence: aMessageNode + | cascade receiver messages msg node | + (token is: $;) ifFalse: [^aMessageNode]. + cascade := self buildNode: compiler cascadeNode at: aMessageNode position. + receiver := aMessageNode receiver. + cascade receiver: receiver. + node := compiler cascadeMessageNode from: aMessageNode. + node cascade: cascade. + messages := OrderedCollection with: node. + [token is: $;] whileTrue: [ + self step. + msg := self buildCascadeMessageNode: receiver. + msg + cascade: cascade; + position: token position; + moveCommentsFrom: token. + messages add: msg. + self cascadeMessage: msg]. + ^cascade messages: messages asArray; end: msg end +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler + ^compiler +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler. + scanner := compiler scanner +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString + self error: aString at: token position +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString at: position + ^compiler error: aString at: position +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +expression + | primary expression | + (token isNameToken and: [self peek isAssignment]) ifTrue: [^self assignment]. + primary := self primary ifNil: [^self missingExpression]. + expression := self unarySequence: primary. + expression := self binarySequence: expression. + expression := self keywordSequence: expression. + expression == primary + ifFalse: [expression := self cascadeSequence: expression]. + token endsExpression ifFalse: [self errorIn: primary]. + ^expression +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffiArguments + | args type | + args := OrderedCollection new. + self step. + token value !!= $( + ifTrue: [ self error: 'expected "("' ]. + self peek value = $) + ifTrue: [ self step. + ^ args ]. + [ type := self ffiType. + args add: type. + self step. + token value = #, ] whileTrue. + token value !!= $) + ifTrue: [ self error: 'expected ")"' ]. + ^ args +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffiCall: aBoolean method: aMethodNode + | cc return name args descriptor | + cc := token value. + return := self ffiType. + aBoolean + ifTrue: [ self step. + name := token value ifNil: [ self error: 'invalid function name' ] ]. + args := self ffiArguments. + args size = aMethodNode selector arity + ifFalse: + [ ^ self error: 'method arity does not match with function arguments' ]. + self step. + descriptor := SFFIDescriptor ret: return args: args cc: cc. + ^ compiler pragmaNode ffi: cc name: name with: descriptor +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffiOrPrimitive: aMethodNode + | tag | + tag := token value asLowercase. + tag last = $: ifFalse: [self invalidPragma]. + tag := tag allButLast. + token value: tag. + tag = 'primitive' ifTrue: [^self primitive]. + tag = 'callback' ifTrue: [ ^self ffiCall: false method: aMethodNode ]. + tag = 'callout' ifTrue: [ ^self ffiCall: true method: aMethodNode ]. + self invalidPragma +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffiType + | type | + self step. + token isNameToken ifFalse: [self error: 'expected type name']. + type := token value. + type = 'struct' ifFalse: [ ^type]. + self step. + token isNameToken ifFalse: [self error: 'expected type name']. + ^token value +! ! + +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasBinarySelector + ^(token isStringToken and: [token hasSymbol]) + or: [token is: $^] + or: [token is: $:] +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasKeywordSelector + ^token isKeyword +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasUnarySelector + ^token isNameToken +! ! + +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! +headlessMethod + | method | + self step. + method := compiler methodNode. + compiler activeScript: method. + self addBodyTo: method. + ^method +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +invalidArrayToken + self error: 'invalid literal entry' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +invalidByteValue + self error: 'value not between 0 and 255' +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +invalidPragma + | position stretch | + position := token position. + stretch := position thru: position. + ^SInvalidPragmaError new stretch: stretch; signal +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +keywordArgument + | arg | + arg := self primary ifNil: [self missingArgument]. + arg := self unarySequence: arg. + ^self binarySequence: arg +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +keywordMessage: aMessageNode + | selector arguments node | + node := self buildNode: compiler selectorNode at: token position. + selector := '' writeStream. + arguments := OrderedCollection new. + [token isKeyword] whileTrue: [ + selector nextPutAll: token value. + node addKeyword: self step. + arguments add: self keywordArgument]. + node symbol: selector contents; end: token prevPosition. + aMessageNode + arguments: arguments; + end: token prevPosition; + selector: node +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +keywordSequence: aParseNode + | expression | + self hasKeywordSelector ifFalse: [^aParseNode]. + expression := self buildMessageNode: aParseNode. + self keywordMessage: expression. + ^expression +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +keywordSignature + | selector arguments node | + selector := '' writeStream. + arguments := OrderedCollection new. + node := self buildNode: compiler selectorNode at: token position. + [token isKeyword] whileTrue: [ + selector nextPutAll: token value. + node addKeyword: token asSelectorNode. + self step. + token isNameToken ifFalse: [self missingArgument]. + arguments add: token asIdentifierNode. + self step]. + arguments isEmpty ifTrue: [^nil]. + node + symbol: selector contents; + end: token end; + moveCommentsFrom: token. + ^self buildMethodNode: node arguments: arguments +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +literalArray + | array | + array := self arrayBody. + self step. + ^array +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +literalByteArray + | node | + node := self byteArrayBody. + self step. + ^node +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +literalKeyword + | keyword | + keyword := token value , scanner nextKeyword value. + ^keyword reduced asSymbol +! ! + +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! +method + | method | + self step. + method := self methodSignature. + method isNil ifTrue: [^nil]. + self addBodyTo: method. + ^method +! ! + +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodFragment + | method | + self step. + method := self methodSignature. + method isNil ifTrue: [^nil]. + [self addBodyTo: method] on: SCompilationError do: []. + ^method +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodPragma + self step. + ^[| method | + method := self methodSignature. + self addTemporariesTo: method; attachPragmaTo: method. + method pragma] + on: SCompilationError + do: [:ex | ex return: compiler pragmaNode] +! ! + +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodSelector + self step. + ^self methodSignature ifNotNil: [:m | m selectorNode] +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodSignature + self keywordSignature ifNotNil: [:m | ^m]. + self binarySignature ifNotNil: [:m | ^m]. + self unarySignature ifNotNil: [:m | ^m]. + self error: 'method signature expected' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +missingArgument + self error: 'argument missing' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +missingExpression + self error: 'missing expression' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +missingLiteral + self error: 'missing literal or named literal' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +missingToken: aString + self error: 'missing ' , aString +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +namedPrimitive + | name pragma | + token isNameToken + ifFalse: [ self invalidPragma ]. + name := token value. + pragma := self buildNode: compiler pragmaNode at: token position. + ^ pragma primitive: 0 name: name asSymbol +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +negativeNumber + token := nil. + ^self negativeNumberOrBinary; step +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +negativeNumberOrBinary + self peek isNumberNode + ifTrue: [token := self next negate position: token position - 1]. + ^token value +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +next + token := next. + next := nil. + ^token ifNil: [token := scanner next] +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +nonIntegerToken + self error: 'non-integer token' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +notify: aString + compiler notify: aString at: token position +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +notify: aString at: position + compiler notify: aString at: position +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +numberedPrimitive + | number pragma | + number := token value. + number isInteger ifFalse: [self invalidPragma]. + pragma := self buildNode: compiler pragmaNode at: token position. + ^pragma primitive: number name: nil +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +on: aString + scanner on: aString +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parenthesizedExpression + | start open expression | + start := token position. + open := self step. + expression := self expression. + expression moveCommentsFrom: open. + (token is: $)) ifFalse: [self missingToken: ')']. + expression isImmediate + ifFalse: [expression position: start; end: token position]. + self step. + ^expression +! ! + +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parse: aString + ^self on: aString; method +! ! + +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseExpression: aString + ^self on: aString; headlessMethod +! ! + +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseFragment: aString + | method | + self on: aString; step. + [ + method := self methodSignature. + method notNil ifTrue: [self addBodyTo: method]] + on: SCompilationError + do: []. + ^method +! ! + +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseTemporaries: aString + self on: aString; step. + ^self methodSignature notNil ifTrue: [self temporaries] +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +peek + | comments | + next ifNotNil: [^next]. + next := scanner next. + next isComment ifFalse: [^next]. + comments := OrderedCollection new: 2. + [ + comments add: next. + next := scanner next. + next isComment] whileTrue. + ^next comments: comments +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +primary + token isNameToken ifTrue: [^self step asIdentifierNode]. + token isLiteral ifTrue: [^self step]. + (token is: $[) ifTrue: [^self block]. + (token is: $() ifTrue: [^self parenthesizedExpression]. + (token is: #'#(') ifTrue: [^self literalArray]. + (token is: #'#[') ifTrue: [^self literalByteArray]. + (compiler supportsBraceNodes and: [token is: ${]) ifTrue: [^self bracedArray]. + (token is: #'-') ifTrue: [^self negativeNumber]. + (token is: #'<') ifTrue: [^self taggedNode]. + ^nil +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +primitive + | primitive | + self step. + primitive := token isNumberNode + ifTrue: [self numberedPrimitive] + ifFalse: [self namedPrimitive]. + self step. + ^primitive +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +pseudoLiteralValue + | value | + token isPoolLiteral ifTrue: [^token literalValue]. + value := token value. + value = 'nil' ifTrue: [^nil]. + value = 'true' ifTrue: [^true]. + value = 'false' ifTrue: [^false]. + ^token isPoolLiteral ifTrue: [token literalValue] ifFalse: [value asSymbol] +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +return + | return expression end node | + return := self step. + expression := self expression. + expression moveCommentsFrom: token. + end := token position. + self skipDots. + node := self buildNode: compiler returnNode at: return position. + ^node + return: return; + end: end; + expression: expression; + moveCommentsFrom: return +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipDots + [token is: $.] whileTrue: [self step] +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +statement + | expression | + ((token is: $^) or: [token is: $↑]) ifTrue: [^self return]. + expression := self expression. + token moveCommentsTo: expression. + ^expression +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +statements + | statements | + statements := OrderedCollection new. + [ + token endsExpression ifTrue: [^statements]. + statements add: self statement. + token is: $.] + whileTrue: [self skipDots]. + ^statements +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +step + | save comments | + save := token. + self next isComment ifFalse: [^save]. + comments := OrderedCollection new: 2. + [ + comments add: token. + self next isComment] whileTrue. + token comments: comments. + ^save +! ! + +!SSmalltalkParser methodsFor: 'ffi support' stamp: 'KenD 28/Jun/2026 13:27:40'! +symbolicPragma + | position symbol pragma | + position := token position. + symbol := self step value. + pragma := self buildNode: compiler pragmaNode at: position. + ^pragma symbol: symbol +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaries + | temporaries | + (token is: #'||') ifTrue: [ + self step. + ^#()]. + token isBar ifFalse: [^#()]. + temporaries := OrderedCollection new. + [ + self step. + token isNameToken] + whileTrue: [ + self validateLocalName: token. + temporaries add: token asIdentifierNode]. + token isBar ifFalse: [self missingToken: '|']. + self step. + ^temporaries +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +token + ^token +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +unaryMessage: aMessageNode + | selector | + selector := self unarySelector. + aMessageNode + selector: selector; + end: selector end; + arguments: #(); + moveCommentsFrom: selector +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +unarySelector + | selector start end node | + selector := token value. + start := token position. + end := start + selector size - 1. + self step. + node := self buildNode: compiler selectorNode at: start. + ^node + symbol: selector; + end: end; + moveCommentsFrom: token +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +unarySequence: aParseNode + | node receiver | + node := aParseNode. + node isNameToken ifTrue: [node := node asIdentifierNode]. + [ + receiver := node. + self hasUnarySelector] + whileTrue: [ + node := self buildMessageNode: receiver. + self unaryMessage: node]. + ^node moveCommentsFrom: token +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +unarySignature + self hasUnarySelector ifFalse: [^nil]. + ^self buildMethodNode: self unarySelector arguments: #() +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +validateLocalName: aSmalltalkToken + aSmalltalkToken isDelimitedIdentifier ifTrue: [^self]. + (aSmalltalkToken value includes: $.) + ifTrue: [self error: 'invalid embedded dot'] +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +warning: aString + compiler warning: aString at: token position +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +warning: aString at: position + compiler warning: aString at: position +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SSmalltalkParser class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSmalltalkParser class + instanceVariableNames: ''! + +!SSmalltalkParser class methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseSelector: aString + | cmp parser | + cmp := SCompiler new. + parser := self new compiler: cmp smalltalkCompiler; on: aString. + ^parser methodSelector ifNotNil: [:n | n value] +! ! + + diff --git a/modules/Compiler/SSmalltalkScanner.Class.st b/modules/Compiler/SSmalltalkScanner.Class.st new file mode 100644 index 00000000..22a30d68 --- /dev/null +++ b/modules/Compiler/SSmalltalkScanner.Class.st @@ -0,0 +1,314 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SSmalltalkScanner category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +Object subclass: #SSmalltalkScanner + instanceVariableNames: 'compiler stream' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildToken: aSmalltalkToken + ^self buildToken: aSmalltalkToken at: stream position +! ! + +!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildToken: aSmalltalkToken at: anInteger + | string | + string := stream copyFrom: anInteger to: stream position. + ^self buildToken: aSmalltalkToken at: anInteger with: string +! ! + +!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildToken: aSmalltalkToken at: anInteger with: anObject + ^aSmalltalkToken + position: anInteger; + value: anObject; + end: stream position +! ! + +!SSmalltalkScanner methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canBeInIdentifier: aCharacter + ^compiler frontend canBeInIdentifier: aCharacter +! ! + +!SSmalltalkScanner methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canStartIdentifier: aCharacter + (compiler frontend canStartIdentifier: aCharacter) ifFalse: [^false]. + aCharacter = $_ + ifTrue: [^stream peek ifNil: [false] ifNotNil: [:ch | ch asInteger >= 33]]. + ^true +! ! + +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler + ^compiler +! ! + +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler. + compiler sourceCode ifNotNil: [:s | self sourceCode: s] +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +end + ^self buildToken: compiler endToken at: stream position + 1 +! ! + +!SSmalltalkScanner methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString + ^self error: aString at: stream position +! ! + +!SSmalltalkScanner methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString at: anInteger + ^compiler error: aString at: anInteger +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBinary: aCharacter + | code | + aCharacter isNil ifTrue: [^false]. + code := aCharacter asInteger. + code < 128 ifTrue: [ + ^#($+ $- $< $> $= $* $/ $\ $| $& $~ $, $@ $% $? $!! $: $^) + includes: aCharacter]. + ^code > 255 +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +next + ^self nextToken +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextArrayPrefix + | string | + string := stream copyFrom: stream position - 1 to: stream position. + ^self + buildToken: compiler delimiterToken + at: stream position - 1 + with: string +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextAssignment + ^self buildToken: compiler delimiterToken at: stream position with: #':=' +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBinarySelector + stream back. + ^self + buildToken: compiler stringToken + at: stream position + 1 + with: self scanBinarySymbol +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBinarySymbol + ^self + buildToken: compiler literalNode + at: stream position + with: self scanBinarySymbol +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextColon + | start char | + start := stream position. + char := stream peek. + ((char = Character space or: [char = Character tab]) and: [(stream peek: 2) second = $=]) ifTrue: [ + stream skip: 1. + char := $=]. + char = $= ifTrue: [ + stream skip. + ^self nextAssignment position: start]. + ^(self isBinary: stream peek) + ifTrue: [self nextBinarySelector] + ifFalse: [self nextSpecialCharacter] + +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextComment + | start comment | + start := stream position. + [ stream atEnd not and:[stream peek !!== $"] ] whileTrue: [stream next]. + stream atEnd ifTrue: [self error: 'unfinished comment' at: start]. + stream position: start. + comment := stream upTo: $". + ^self buildToken: compiler commentNode at: start with: comment + +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextIdentifierOrKeyword + | start | + start := stream position. + self skipIdentifier. + ((stream peekFor: $:) and: [stream peekFor: $=]) ifTrue: [stream skip: -2]. + ^self buildToken: compiler stringToken at: start +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextKeyword + | start string | + start := stream position + 1. + self skipKeyword. + string := stream copyFrom: start to: stream position. + ^self buildToken: compiler literalNode at: start - 1 with: string asSymbol +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextLiteralCharacter + stream atEnd ifTrue: [^self error: 'character expected']. + ^self + buildToken: compiler literalNode + at: stream position + with: stream next +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextLiteralString + ^self + buildToken: compiler literalNode + at: stream position + with: self scanString reduced +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextNumber + | parser assoc | + stream skip: -1. + parser := NumberParser new on: stream. + assoc := parser next. + parser error ifNotNil: [:e | ^self error: e key at: e value]. + ^self + buildToken: compiler numericLiteralNode + at: assoc value start + with: assoc key +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextQuotedSymbol + | node | + node := self nextLiteralString. + ^node beSymbol; position: node position - 1 +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextSpecialCharacter + | token | + token := self buildToken: compiler delimiterToken. + ^token beCharacter +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextSymbolOrArrayPrefix + | char | + stream atEnd ifTrue: [self error: 'character expected']. + char := stream peek. + (self canBeInIdentifier: char) ifTrue: [^self nextKeyword]. + (self isBinary: char) ifTrue: [^self nextBinarySymbol]. + stream next. + (char = $[ or: [char = $(]) ifTrue: [^self nextArrayPrefix]. + char = $' ifTrue: [^self nextQuotedSymbol]. + self error: 'character expected' +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextToken + | first | + first := self scanChar. + first isNil ifTrue: [^self end]. + (self canStartIdentifier: first) ifTrue: [^self nextIdentifierOrKeyword]. + (first = $→ or: [first = $_]) ifTrue: [^self nextAssignment]. + first = $: ifTrue: [^self nextColon]. + first = $' ifTrue: [^self nextLiteralString]. + first = $$ ifTrue: [^self nextLiteralCharacter]. + first = $# ifTrue: [^self nextSymbolOrArrayPrefix]. + first = $" ifTrue: [^self nextComment]. + first isDigit ifTrue: [^self nextNumber]. + (first !!= $^ and: [first !!= $↑ and: [self isBinary: first]]) + ifTrue: [^self nextBinarySelector]. + ^self nextSpecialCharacter +! ! + +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +on: aString + stream := aString readStream. + compiler notNil ifTrue: [compiler sourceCode: aString] +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +scanBinarySymbol + | start symbol | + start := stream position. + self skipBinary. + symbol := stream copyFrom: start + 1 to: stream position. + ^symbol asSymbol +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +scanChar + ^(stream skipSeparators; atEnd) ifFalse: [stream next] + +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +scanString + | current start | + start := current := stream position. + ^String streamContents: [:writer | + [| fragment | + fragment := stream upTo: $'. + writer nextPutAll: fragment. + (current < stream position and: [(stream back; next) = $']) + ifFalse: [self error: 'string end expected' at: start]. + stream peekFor: $'] + whileTrue: [ + writer nextPut: $'. + current := stream position]] +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipBinary + [self isBinary: stream peek] whileTrue: [stream next] +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipIdentifier + | frontend | + frontend := compiler frontend. + [stream atEnd] + whileFalse: [(frontend peekForIdentifier: stream) ifFalse: [^self]] +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipKeyword + | frontend continue pos | + frontend := compiler frontend. + [ + self skipIdentifier. + continue := false. + (stream peekFor: $:) ifTrue: [ + pos := stream position. + stream atEnd + ifFalse: [continue := frontend canStartIdentifier: stream peek]]. + continue] whileTrue. + pos isNil ifFalse: [stream position: pos] +! ! + +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sourceCode: aString + stream := aString readStream +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SSmalltalkScanner class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSmalltalkScanner class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SStringNode.Class.st b/modules/Compiler/SStringNode.Class.st new file mode 100644 index 00000000..f07f243f --- /dev/null +++ b/modules/Compiler/SStringNode.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SStringNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SLiteralNode subclass: #SStringNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SStringNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitString: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SStringNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SStringNode class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SStringToken.Class.st b/modules/Compiler/SStringToken.Class.st new file mode 100644 index 00000000..5d4ed220 --- /dev/null +++ b/modules/Compiler/SStringToken.Class.st @@ -0,0 +1,58 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SStringToken category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSymbolicToken subclass: #SStringToken + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! +asIdentifierNode + ^compiler identifierNode + name: value; + stretch: stretch; + comments: comments +! ! + +!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! +asSelectorNode + ^compiler selectorNode symbol: value; stretch: stretch +! ! + +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasSymbol + ^value isSymbol +! ! + +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBinary + ^value isSymbol +! ! + +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDelimitedIdentifier + ^value first = ${ +! ! + +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isKeyword + ^value last = $: +! ! + +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isNameToken + ^(self isKeyword or: [self isBinary]) not +! ! + +!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! +isStringToken + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SStringToken class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SStringToken class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SSymbolicToken.Class.st b/modules/Compiler/SSymbolicToken.Class.st new file mode 100644 index 00000000..807a76b4 --- /dev/null +++ b/modules/Compiler/SSymbolicToken.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SSymbolicToken category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SToken subclass: #SSymbolicToken + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SSymbolicToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +is: anObject + ^value == anObject +! ! + +!SSymbolicToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^value +! ! + +!SSymbolicToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: anObject + value := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SSymbolicToken class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSymbolicToken class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/SToken.Class.st b/modules/Compiler/SToken.Class.st new file mode 100644 index 00000000..8a9dc82d --- /dev/null +++ b/modules/Compiler/SToken.Class.st @@ -0,0 +1,187 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SToken category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +Object subclass: #SToken + instanceVariableNames: 'compiler stretch comments' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +comment + ^comments notNil ifTrue: [comments anyOne] +! ! + +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +comments + ^comments +! ! + +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +comments: aCollection + aCollection isNil ifTrue: [^self]. + comments isNil + ifTrue: [comments := aCollection] + ifFalse: [comments addAll: aCollection] +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compileWarning: aString + compiler notify: aString at: self stretch +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler + ^compiler +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +end + ^stretch end +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +end: aNumber + stretch end: aNumber +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +endsExpression + ^self isEnd +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasSymbol + ^false +! ! + +!SToken methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + stretch := 1 thru: 0 +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +is: anObject + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isAssignment + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBar + ^(self is: #'|') or: [self is: #'/'] +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBlockNode + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isComment + ^false +! ! + +!SToken methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDelimitedIdentifier + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDelimiter + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isEnd + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isIdentifier + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isKeyword + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLiteral + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isNameToken + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isNumberNode + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isPoolLiteral + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isStringToken + ^false +! ! + +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveCommentsTo: aParseNode + aParseNode comments: comments. + comments := nil +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +position + ^stretch start +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +position: aNumber + stretch start: aNumber +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prevPosition + ^stretch start - 1 +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +source + ^compiler sourceCode copyFrom: stretch start to: stretch end +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stretch + ^stretch +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stretch: aStretch + stretch := aStretch +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SToken class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SToken class + instanceVariableNames: ''! + + +SToken initialize! + diff --git a/modules/Compiler/SUndeclaredIdentifierError.Class.st b/modules/Compiler/SUndeclaredIdentifierError.Class.st new file mode 100644 index 00000000..41014dea --- /dev/null +++ b/modules/Compiler/SUndeclaredIdentifierError.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SUndeclaredIdentifierError category: #'Powerlang-Core-SCompiler'! +SCompilationError subclass: #SUndeclaredIdentifierError + instanceVariableNames: 'identifier assigned' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!SUndeclaredIdentifierError methodsFor: 'accessing-token' stamp: 'KenD 28/Jun/2026 13:27:40'! +assignment: aBoolean + assigned := aBoolean +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +identifier + ^ identifier +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isUndeclaredAccess + ^assigned not +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isUndeclaredAssignment + ^assigned +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stretch: aStretch + super stretch: aStretch. + identifier := self source +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SUndeclaredIdentifierError class' category: #'Powerlang-Core-SCompiler'! +SUndeclaredIdentifierError class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/ScriptScope.Class.st b/modules/Compiler/ScriptScope.Class.st new file mode 100644 index 00000000..7e8af302 --- /dev/null +++ b/modules/Compiler/ScriptScope.Class.st @@ -0,0 +1,155 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ScriptScope category: #'Powerlang-Core-SCompiler'! +Object subclass: #ScriptScope + instanceVariableNames: 'script arguments temporaries stackSize envSize captureSelf' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +capturesSelf + ^ captureSelf +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +defineArgument: identifier + | binding | + (self resolves: identifier) ifTrue: [self redefinitionError: identifier]. + binding := ArgumentBinding new name: identifier. + arguments define: identifier as: binding. + ^binding +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +defineTemporary: identifier + | binding | + (temporaries defines: identifier) + ifTrue: [self redefinitionError: identifier]. + binding := TemporaryBinding new name: identifier. + temporaries define: identifier as: binding. + ^binding +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +defines: aString + ^(temporaries defines: aString) or: [arguments defines: aString] +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +describe: identifier + | binding type | + binding := self resolve: identifier. + type := self class name asLowercase allButLast: 'scope' size. + ^binding description , ' of ' , type +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentSize + ^envSize +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +growEnvironment + ^envSize := envSize + 1 +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +growStack + ^stackSize := stackSize + 1 +! ! + +!ScriptScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + arguments := StaticBinder new. + temporaries := StaticBinder new. + stackSize := envSize := 0. + captureSelf := false. +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +localBindings + ^arguments values , temporaries values +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionDefinedArguments + arguments withIndexDo: [:binding :index | binding index: index] +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionDefinedLocals + self positionDefinedTemporariesIn: self; positionDefinedArguments +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionDefinedTemporariesIn: aScriptScope + temporaries do: [:binding | | position | + position := binding isInStack + ifTrue: [aScriptScope growStack] + ifFalse: [aScriptScope growEnvironment]. + binding index: position] +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionLocals + self positionDefinedLocals +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +realScope + ^script realScript scope +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +redefinitionError: name + | scope description | + scope := self scopeOf: name. + description := scope describe: name. + script compiler + warning: name , ' already declared as ' , description + at: script stretch +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolveLocal: aString + (temporaries at: aString) ifNotNil: [:binding | ^binding]. + ^arguments at: aString +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolves: aString + ^(self resolve: aString) isDynamic not +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +scopeOf: aString + | s | + s := self scriptDefining: aString. + ^s notNil ifTrue: [s scope] +! ! + +!ScriptScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +script: aScriptNode + script := aScriptNode +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +stackSize + ^stackSize +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ScriptScope class' category: #'Powerlang-Core-SCompiler'! +ScriptScope class + instanceVariableNames: ''! + +!ScriptScope class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +on: aScriptNode + ^self new script: aScriptNode +! ! + + +ScriptScope initialize! + diff --git a/modules/Compiler/SelfBinding.Class.st b/modules/Compiler/SelfBinding.Class.st new file mode 100644 index 00000000..a98fb3d3 --- /dev/null +++ b/modules/Compiler/SelfBinding.Class.st @@ -0,0 +1,40 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SelfBinding category: #'Powerlang-Core-SCompiler-Bindings'! +Binding subclass: #SelfBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!SelfBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +beReferencedFrom: aScriptNode + aScriptNode useSelf +! ! + +!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canBeAssigned + ^false +! ! + +!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeSelf +! ! + +!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSelf + ^true +! ! + +!SelfBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^'self' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SelfBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +SelfBinding class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/Species.Extension.st b/modules/Compiler/Species.Extension.st new file mode 100644 index 00000000..ddd0fe12 --- /dev/null +++ b/modules/Compiler/Species.Extension.st @@ -0,0 +1,11 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! + + +!Species methodsFor: '*Compiling' stamp: 'KenD 28/Jun/2026 13:27:40'! +compile: aString + | method | + method := SCompiler compile: aString in: self. + method ifNotNil: [method install] +! ! + + diff --git a/modules/Compiler/StackEnvironment.Class.st b/modules/Compiler/StackEnvironment.Class.st new file mode 100644 index 00000000..ca8b9bbc --- /dev/null +++ b/modules/Compiler/StackEnvironment.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #StackEnvironment category: #'Powerlang-Core-SCompiler'! +LocalEnvironment subclass: #StackEnvironment + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!StackEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^nil +! ! + +!StackEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +isStack + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'StackEnvironment class' category: #'Powerlang-Core-SCompiler'! +StackEnvironment class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/StaticBinder.Class.st b/modules/Compiler/StaticBinder.Class.st new file mode 100644 index 00000000..9a11e45e --- /dev/null +++ b/modules/Compiler/StaticBinder.Class.st @@ -0,0 +1,77 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #StaticBinder category: #'Powerlang-Core-SCompiler'! +IdentifierBinder subclass: #StaticBinder + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: aString + ^contents at: aString ifAbsent: nil +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: aString ifAbsentPut: aBlock + ^contents at: aString ifAbsentPut: aBlock +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: aString put: aBinding + contents at: aString put: aBinding +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +define: aString as: aBinding + contents at: aString put: aBinding +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +defines: identifier + ^contents includesKey: identifier +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +do: aBlock + contents do: aBlock +! ! + +!StaticBinder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + contents := OrderedDictionary new +! ! + +!StaticBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream indent: anInteger + aStream tab: anInteger; nextPut: $<. + contents keys + do: [:name | name printOn: aStream] + separatedBy: [aStream space]. + aStream nextPut: $> +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +select: aBlock + ^contents select: aBlock +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +values + ^contents values +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +withIndexDo: aBlock + contents withIndexDo: aBlock +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'StaticBinder class' category: #'Powerlang-Core-SCompiler'! +StaticBinder class + instanceVariableNames: ''! + + +StaticBinder initialize! + diff --git a/modules/Compiler/SuperBinding.Class.st b/modules/Compiler/SuperBinding.Class.st new file mode 100644 index 00000000..98e8e792 --- /dev/null +++ b/modules/Compiler/SuperBinding.Class.st @@ -0,0 +1,35 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SuperBinding category: #'Powerlang-Core-SCompiler-Bindings'! +SelfBinding subclass: #SuperBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!SuperBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeSuper +! ! + +!SuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSelf + ^false +! ! + +!SuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSuper + ^true +! ! + +!SuperBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^'super' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SuperBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +SuperBinding class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/TemporaryBinding.Class.st b/modules/Compiler/TemporaryBinding.Class.st new file mode 100644 index 00000000..250d27d8 --- /dev/null +++ b/modules/Compiler/TemporaryBinding.Class.st @@ -0,0 +1,38 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TemporaryBinding category: #'Powerlang-Core-SCompiler-Bindings'! +LocalBinding subclass: #TemporaryBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!TemporaryBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +description + ^'temporary ' , name +! ! + +!TemporaryBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEncoder + aTreecodeEncoder encodeTemporary: index env: environment +! ! + +!TemporaryBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + environment := StackEnvironment new +! ! + +!TemporaryBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isTemporary + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TemporaryBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +TemporaryBinding class + instanceVariableNames: ''! + + +TemporaryBinding initialize! + diff --git a/modules/Compiler/Tests/MessageInlinerTest.Class.st b/modules/Compiler/Tests/MessageInlinerTest.Class.st new file mode 100644 index 00000000..8d4f8d1e --- /dev/null +++ b/modules/Compiler/Tests/MessageInlinerTest.Class.st @@ -0,0 +1,82 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #MessageInlinerTest category: #'Compiler.Tests'! +TestCase subclass: #MessageInlinerTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler.Tests'! +!MessageInlinerTest commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!MessageInlinerTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:27:41'! +ast: source + ^SCompiler new parse: source +! ! + +!MessageInlinerTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:27:41'! +cascadeMessagesIn: source + | ast cascadeMessages | + ast := self ast: source. + cascadeMessages := OrderedCollection new. + ast nodesDo: [:n | + (n isMessageNode and: [n isCascadeMessage]) + ifTrue: [cascadeMessages add: n]]. + ^cascadeMessages +! ! + +!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +testCascadeAndKeywordIsNotInlined + "Regression: a keyword cascade message such as `at:put:` must not be inlined." + | messages | + messages := self cascadeMessagesIn: 'foo + ^Dictionary new at: #a put: 1; at: #b put: 2; yourself'. + messages do: [:m | self deny: m isInlined] +! ! + +!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +testCascadeIfTrueIsNotInlined + "Regression: ifTrue: as the first message of a cascade must not be inlined, + because the cascade machinery needs the receiver (a Boolean) to receive + the subsequent messages. This is the pattern that the original + InternalReadStream>>peekFor: relied on: + ^self peek = token ifTrue: [position := position + 1]; yourself" + | messages | + messages := self cascadeMessagesIn: 'foo + ^true ifTrue: [42]; yourself'. + self assert: messages size = 2. + messages do: [:m | self deny: m isInlined] +! ! + +!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +testCascadeWhileTrueIsNotInlined + "Regression: whileTrue: in a cascade must not be inlined either." + | messages | + messages := self cascadeMessagesIn: 'foo + ^[true] whileTrue: [^1]; yourself'. + messages do: [:m | self deny: m isInlined] +! ! + +!MessageInlinerTest methodsFor: 'tests - non-cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +testNonCascadeIfTrueIsInlined + "Sanity check: outside a cascade, ifTrue: is still inlined as expected." + | ast inlined | + ast := self ast: 'foo + ^true ifTrue: [42]'. + inlined := false. + ast nodesDo: [:n | + (n isMessageNode and: [n isInlined]) + ifTrue: [inlined := true]]. + self assert: inlined +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MessageInlinerTest class' category: #'Compiler.Tests'! +MessageInlinerTest class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/Tests/SmalltalkScannerTest.Class.st b/modules/Compiler/Tests/SmalltalkScannerTest.Class.st new file mode 100644 index 00000000..48e2e60d --- /dev/null +++ b/modules/Compiler/Tests/SmalltalkScannerTest.Class.st @@ -0,0 +1,400 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #SmalltalkScannerTest category: #'Compiler.Tests'! +TestCase subclass: #SmalltalkScannerTest + instanceVariableNames: 'scanner' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler.Tests'! +!SmalltalkScannerTest commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!SmalltalkScannerTest methodsFor: 'setup' stamp: 'KenD 28/Jun/2026 13:27:41'! +setUp + super setUp. + scanner := SCompiler new smalltalkScanner +! ! + +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +test0xNotation + | node | + node := SCompiler new smalltalkParser parseExpression: '0x10'. + self assert: node statements first value = 16. + node := SCompiler new smalltalkParser parseExpression: '0X10'. + self assert: node statements first value = 16 +! ! + +!SmalltalkScannerTest methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:41'! +testArrayStart + | node | + scanner on: '#()'. + node := scanner next. + self + assert: (node is: #'#('); + assert: node source = '#('. + scanner on: '#['. + node := scanner next. + self + assert: (node is: #'#['); + assert: node source = '#['. + scanner on: '#''hello'''. + node := scanner next. + self + assert: node value = #hello; + assert: node source = '#''hello''' +! ! + +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +testBinary + | node | + scanner on: '- + -- + --- + ==> + ~!!|\/%&*+=><'. + node := scanner next. + self + assert: node isBinary; + assert: node value = #'-'; + assert: node source = '-'. + node := scanner next. + self + assert: node isBinary; + assert: node value = #'--'; + assert: node source = '--'. + node := scanner next. + self + assert: node isBinary; + assert: node value = #'---'; + assert: node source = '---'. + node := scanner next. + self + assert: node isBinary; + assert: node value = #'==>'; + assert: node source = '==>'. + node := scanner next. + self + assert: node isBinary; + assert: node value = #'~!!|\/%&*+=><'; + assert: node source = '~!!|\/%&*+=><' +! ! + +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +testBinarySymbol + | node | + scanner on: '#='. + node := scanner next. + self + assert: node isLiteral; + assert: node hasSymbol; + assert: node value = #'=' +! ! + +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +testCharacter + | node | + scanner on: '$a$b'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = $a; + assert: node source = '$a'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = $b; + assert: node source = '$b' +! ! + +!SmalltalkScannerTest methodsFor: 'colons' stamp: 'KenD 28/Jun/2026 13:27:41'! +testColon + | node | + scanner on: ':a'. + node := scanner next. + self + assert: (node is: $:); + assert: node source = ':'. + node := scanner next. + self + assert: node value = 'a'; + assert: node source = 'a'. + scanner on: ':='. + node := scanner next. + self + assert: node isAssignment; + assert: node source = ':=' +! ! + +!SmalltalkScannerTest methodsFor: 'colons' stamp: 'KenD 28/Jun/2026 13:27:41'! +testColon2 + | node | + scanner on: '::'. + node := scanner next. + self + assert: node class = SStringToken; + assert: node source = '::' +! ! + +!SmalltalkScannerTest methodsFor: 'comments' stamp: 'KenD 28/Jun/2026 13:27:41'! +testComment + | node | + scanner on: '"comment"a'. + node := scanner next. + self + assert: node isComment; + assert: node value = 'comment'; + assert: node source = '"comment"'. + scanner on: '"comment"'. + node := scanner next. + self + assert: node isComment; + assert: node source = '"comment"'; + assert: node position = 1. + scanner on: 'a"comment"'. + node := scanner next. + self + assert: node isNameToken; + assert: node value = 'a'; + assert: node source = 'a'. + node := scanner next. + self + assert: node isComment; + assert: node position = ('a' size + 1) +! ! + +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +testDashStartingSymbol + | node | + scanner on: '#++'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'++'; + assert: node source = '#++'. + scanner on: '#//'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'//'; + assert: node source = '#//'. + scanner on: '#--'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'--'; + assert: node source = '#--'. + scanner on: '#+-'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'+-'; + assert: node source = '#+-' +! ! + +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +testEmpty + scanner on: ''. + self assert: scanner next isEnd +! ! + +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +testFloat + | node | + scanner on: '0.1'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 0.1; + assert: node source = '0.1'. + scanner on: '0.1e-35'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 0.1e-35; + assert: node source = '0.1e-35' +! ! + +!SmalltalkScannerTest methodsFor: 'identifiers' stamp: 'KenD 28/Jun/2026 13:27:41'! +testIdentifier + | node | + scanner on: 'a'. + node := scanner next. + self + assert: node isNameToken; + assert: node value = 'a'; + assert: node source = 'a'. + scanner on: ' a1'. + node := scanner next. + self + assert: node isNameToken; + assert: node value = 'a1'; + assert: node source = 'a1'. + scanner on: '_a'. + node := scanner next. + self + assert: node isNameToken; + assert: node value = '_a'; + assert: node source = '_a'. + scanner on: 'a_1b'. + node := scanner next. + self + assert: node isNameToken; + assert: node value = 'a_1b'; + assert: node source = 'a_1b' +! ! + +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +testInteger + | node | + scanner on: '0 12 -35'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 0; + assert: node source = '0'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 12; + assert: node source = '12'. + node := scanner next. + self + deny: node isNumberNode; + assert: (node is: #'-'); + assert: node source = '-'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 35; + assert: node source = '35' +! ! + +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +testIntegerRadix + | node | + scanner on: '16rFA2'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 16rFA2; + assert: node source = '16rFA2' +! ! + +!SmalltalkScannerTest methodsFor: 'identifiers' stamp: 'KenD 28/Jun/2026 13:27:41'! +testKeyword + | node node2 | + scanner on: 'a:'. + node := scanner next. + self + assert: node isKeyword; + assert: node value = 'a:'; + assert: node source = 'a:'. + scanner on: 'ab:cd:'. + node := scanner next. + node2 := scanner next. + self + assert: node isKeyword; + assert: node value = 'ab:'; + assert: node source = 'ab:'; + assert: node2 isKeyword; + assert: node2 value = 'cd:'; + assert: node2 source = 'cd:' +! ! + +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +testNumericSymbol + scanner on: '#35'. + self assert: scanner next value = '35' asSymbol +! ! + +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +testString + | node quote | + scanner on: '' storeString. + node := scanner next. + self + assert: node isLiteral; + assert: node value = ''; + assert: node source = (String with: $' with: $'). + scanner on: 'Hello World!!' storeString. + node := scanner next. + self + assert: node isLiteral; + assert: node value = 'Hello World!!'; + assert: node source = 'Hello World!!' storeString. + quote := String with: $'. + scanner on: quote storeString. + node := scanner next. + self + assert: node isLiteral; + assert: node value = quote; + assert: node source = quote storeString +! ! + +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +testSymbol + | node | + scanner on: '#-'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'-'; + assert: node source = '#-'. + scanner on: '#a:'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #a:; + assert: node source = '#a:'. + scanner on: '#-!!'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'-!!'; + assert: node source = '#-!!'. + scanner on: '#a:b:'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #a:b:; + assert: node source = '#a:b:'. + scanner on: '#a:b'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #a:; + assert: node source = '#a:'. + node := scanner next. + self assert: node value = 'b'; assert: node source = 'b' +! ! + +!SmalltalkScannerTest methodsFor: 'unicode' stamp: 'KenD 28/Jun/2026 13:27:41'! +testUnicodeScanning + "#knownIssue: depends on Character class>>value: path that resolves UnicodeLibrary, + which is not yet defined in the egg Kernel. Re-enable once UnicodeLibrary is ported." + | next three tensor | + #knownIssue. + self assert: false. + scanner on: '3 + 4' asWideString. + self assert: scanner next value = 3. + next := scanner next. + self + assert: next value == #'+'; + assert: scanner next value = 4. + scanner on: '3' asWideString , 8855 asCharacter asString , '4' asWideString. + three := scanner next. + self assert: three value = 3. + tensor := scanner next. + self assert: tensor value = 8855 asCharacter asString asSymbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SmalltalkScannerTest class' category: #'Compiler.Tests'! +SmalltalkScannerTest class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/Tests/TestsModule.Class.st b/modules/Compiler/Tests/TestsModule.Class.st new file mode 100644 index 00000000..aba59451 --- /dev/null +++ b/modules/Compiler/Tests/TestsModule.Class.st @@ -0,0 +1,46 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #TestsModule category: #'Compiler.Tests'! +Module subclass: #TestsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Compiler.Tests'! +!TestsModule commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!TestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:41'! +imports + ^{ + #Kernel -> #(Array Error Exception OrderedCollection UndefinedObject WideString WideSymbol). + #Compiler -> #(SCompiler SCompilationError SMethodNode SSelectorNode SMessageNode SStringToken InlinedArgEnvironment MethodScope). + #SUnit -> #(TestCase TestResult TestSuite) + } +! ! + +!TestsModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:41'! +main: anArray + | suite result | + Kernel log: 'Running Compiler tests... +'. + suite := TestSuite forModule: self. + Kernel log: 'suite built with ', suite tests size printString, ' tests +'. + result := suite run. + Kernel log: 'Done. +'. + Kernel log: result printString. + Kernel log: ' +' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestsModule class' category: #'Compiler.Tests'! +TestsModule class + instanceVariableNames: ''! + + diff --git a/modules/Compiler/TreecodeEncoder.Class.st b/modules/Compiler/TreecodeEncoder.Class.st new file mode 100644 index 00000000..d5a195a9 --- /dev/null +++ b/modules/Compiler/TreecodeEncoder.Class.st @@ -0,0 +1,351 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TreecodeEncoder category: #'Powerlang-Core-SExpressions'! +SParseTreeVisitor subclass: #TreecodeEncoder + instanceVariableNames: 'method stream script' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiledBlockIndexOf: aBlockNode + | index | + index := method + findFirst: [:literal | literal isBlock + and: [literal blockNumber == aBlockNode index]]. + ^index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeArgument: anInteger env: environment + | encoded | + encoded := self encodedEnvironment: environment. + self + nextPut: ArgumentId; + nextIntegerPut: anInteger; + nextIntegerPut: encoded +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeClosureElements: aBlockNode + | scope parent | + scope := aBlockNode scope. + parent := aBlockNode realParent. + ^Array streamContents: [:s | + scope capturesSelf ifTrue: [ s nextPut: CaptureSelf ]. + scope capturedEnvironments do: [:e | | index | + e == parent ifTrue: [s nextPut: CaptureEnvironment] ifFalse: [ + index := aBlockNode environmentIndexOf: e. + self ASSERT: index notNil. + s nextPut: CaptureEnvironmentValue; nextPut: index]]. + scope capturedArguments do: [:a | | binding | + binding := aBlockNode parent scope resolve: a name. + s nextPut: binding environmentCaptureType; nextPut: binding index]] + +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeDynamicVar: name + stream nextPut: DynamicVarId. + self nextSymbolPut: name +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeFalse + stream nextPut: FalseId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeLoadRvisitingReceiver + stream nextPut: LoadRvisitingReceiverId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeNestedDynamicVar: name + stream nextPut: NestedDynamicVarId. + self nextLiteralPut: name +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeNil + stream nextPut: NilId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodePopR + stream nextPut: PopRid +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodePushR + stream nextPut: PushRid +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeSelf + stream nextPut: SelfId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeSuper + stream nextPut: SuperId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeTemporary: anInteger env: environment + | encoded | + encoded := self encodedEnvironment: environment. + self + nextPut: TemporaryId; + nextIntegerPut: anInteger; + nextIntegerPut: encoded +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeTrue + stream nextPut: TrueId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodedEnvironment: aLocalEnvironment + aLocalEnvironment isStack + ifTrue: [ ^ aLocalEnvironment isInlinedArgument + ifTrue: [ -1 ] + ifFalse: [ -2 ] ]. + aLocalEnvironment isCurrent + ifTrue: [ ^ 0 ]. + ^ aLocalEnvironment index +! ! + +!TreecodeEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + stream := #[] writeStream +! ! + +!TreecodeEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +method: aCompiledMethod + method := aCompiledMethod +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBigIntegerPut: anInteger + stream + nextPut: 16r80; + nextInt64Put: anInteger +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBooleanPut: aBoolean + stream nextPut: aBoolean asParameter + +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextIntegerPut: anInteger + | value | + (anInteger > 127 or: [ anInteger < -127 ]) + ifTrue: [ ^ self nextBigIntegerPut: anInteger ]. + value := anInteger >= 0 + ifTrue: [ anInteger ] + ifFalse: [ anInteger + 16r100 ]. + stream nextPut: value +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextLiteralPut: anObject + | index | + index := method + indexOf: anObject + ifAbsent: [ self ASSERT: false ]. + self nextIntegerPut: index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextPut: anInteger + stream nextPut: anInteger +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextPutAll: aCollection + stream nextPut: aCollection size; nextPutAll: aCollection +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextSymbolPut: aSymbol + | index | + index := method + indexOf: aSymbol asSymbol + ifAbsent: [ self ASSERT: false ]. + self nextIntegerPut: index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextTypePut: anInteger + stream nextPut: anInteger +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitAssignment: anAssignmentNode + | assignees | + self nextTypePut: AssignmentId. + assignees := anAssignmentNode assignees. + self nextIntegerPut: assignees size. + assignees do: [ :node | node acceptVisitor: self ]. + anAssignmentNode expression acceptVisitor: self +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBlock: aBlockNode + | args inlined | + self nextTypePut: BlockId. + inlined := aBlockNode isInlined. + self nextBooleanPut: inlined. + inlined + ifTrue: [ args := aBlockNode arguments collect: [ :id | id binding index ]. + self nextPutAll: args asArray ] + ifFalse: [ | index captured | + index := self compiledBlockIndexOf: aBlockNode. + self nextPut: index. + captured := self encodeClosureElements: aBlockNode. + self nextPutAll: captured ]. + self visitScript: aBlockNode +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBraceNode: aBraceNode + aBraceNode isLiteral + ifTrue: [self visitLiteral: aBraceNode asLiteralNode] + ifFalse: [self visitCascade: aBraceNode asMessageNode] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascade: aCascadeNode + | messages | + self nextTypePut: CascadeId. + aCascadeNode receiver acceptVisitor: self. + messages := aCascadeNode messages. + self nextIntegerPut: messages size. + messages do: [ :node | self visitCascadeMessage: node ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascadeMessage: aCascadeMessageNode + | arguments | + self nextSymbolPut: aCascadeMessageNode selector symbol. + arguments := aCascadeMessageNode arguments. + self nextIntegerPut: arguments size. + arguments do: [ :arg | arg acceptVisitor: self ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitIdentifier: anIdentifierNode + self nextTypePut: IdentifierId. + anIdentifierNode binding encodeUsing: self +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitLiteral: aLiteralNode + | index | + index := method indexOf: aLiteralNode value. + self + nextTypePut: LiteralId; + nextIntegerPut: index. + index = 0 + ifTrue: [ self nextIntegerPut: aLiteralNode value ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMessage: aMessageNode + | arguments | + self + nextTypePut: MessageId; + nextBooleanPut: aMessageNode isInlined; + nextSymbolPut: aMessageNode selector symbol. + aMessageNode receiver acceptVisitor: self. + arguments := aMessageNode arguments. + self nextIntegerPut: arguments size. + arguments do: [ :arg | arg acceptVisitor: self ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMethod: aMethodNode + | pragma | + self nextTypePut: MethodId. + pragma := aMethodNode pragma. + pragma isUsed + ifTrue: [ self nextTypePut: PragmaId. + pragma name + ifNotNil: [ self nextSymbolPut: pragma name ] + ifNil: [ self nextPut: 0 ] ]. + self visitScript: aMethodNode. + ^ stream contents +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitParseNode: aParseNode + ^self ASSERT: false +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitReturn: aReturnNode + self + nextTypePut: ReturnId; + nextBooleanPut: script realScript isMethod. + + aReturnNode expression acceptVisitor: self +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitScript: aScriptNode + | prev statements | + prev := script. + script := aScriptNode. + statements := aScriptNode statements. + self nextIntegerPut: statements size. + statements do: [ :node | node acceptVisitor: self ]. + script := prev +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TreecodeEncoder class' category: #'Powerlang-Core-SExpressions'! +TreecodeEncoder class + instanceVariableNames: ''! + +!TreecodeEncoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeTreecodeIds + | named | + named := self addNamespaceAs: #TreecodeIds. + named + at: #MethodId put: 101; + at: #BlockId put: 102; + at: #IdentifierId put: 103; + at: #LiteralId put: 104; + at: #MessageId put: 105; + at: #CascadeId put: 106; + at: #BraceId put: 107; + at: #AssignmentId put: 108; + at: #ReturnId put: 109; + at: #PragmaId put: 110 +! ! + +!TreecodeEncoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeBindingIds + | named | + named := self addNamespaceAs: #BindingIds. + named + at: #NilId put: 1; + at: #TrueId put: 2; + at: #FalseId put: 3; + at: #ArgumentId put: 4; + at: #TemporaryId put: 5; + at: #SelfId put: 6; + at: #SuperId put: 7; + at: #DynamicVarId put: 14; + at: #NestedDynamicVarId put: 15; + at: #PushRid put: 50; + at: #PopRid put: 51 +! ! + + +TreecodeEncoder initialize! + diff --git a/modules/Compiler/TrueBinding.Class.st b/modules/Compiler/TrueBinding.Class.st new file mode 100644 index 00000000..db1394d0 --- /dev/null +++ b/modules/Compiler/TrueBinding.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TrueBinding category: #'Powerlang-Core-SCompiler-Bindings'! +LiteralBinding subclass: #TrueBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!TrueBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeTrue +! ! + +!TrueBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^'true' +! ! + +!TrueBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TrueBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +TrueBinding class + instanceVariableNames: ''! + + diff --git a/modules/Development/BeginningCondition.Class.st b/modules/Development/BeginningCondition.Class.st new file mode 100644 index 00000000..611c5941 --- /dev/null +++ b/modules/Development/BeginningCondition.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #BeginningCondition category: #Development! +CodeSearchCondition subclass: #BeginningCondition + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!BeginningCondition commentStamp: '' prior: 0! + + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +! + +!BeginningCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +compare: aString + ^aString beginsWith: text +! ! + +!BeginningCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +proposition + ^'begins with' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BeginningCondition class' category: #Development! +BeginningCondition class + instanceVariableNames: ''! + + diff --git a/modules/Development/ClassSearch.Class.st b/modules/Development/ClassSearch.Class.st new file mode 100644 index 00000000..a5e2c024 --- /dev/null +++ b/modules/Development/ClassSearch.Class.st @@ -0,0 +1,29 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #ClassSearch category: #Development! +CodeSearch subclass: #ClassSearch + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!ClassSearch commentStamp: '' prior: 0! + + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +! + +!ClassSearch methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +search + self reset. + Kernel namespace keysAndValuesDo: [:name :global | + (global isClass and: [self includes: name]) + ifTrue: [results add: (CodeSearchResult class: global)]] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ClassSearch class' category: #Development! +ClassSearch class + instanceVariableNames: ''! + + diff --git a/modules/Development/CodeSearch.Class.st b/modules/Development/CodeSearch.Class.st new file mode 100644 index 00000000..ec94a8c6 --- /dev/null +++ b/modules/Development/CodeSearch.Class.st @@ -0,0 +1,169 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #CodeSearch category: #Development! +Object subclass: #CodeSearch + instanceVariableNames: 'condition results sorter' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!CodeSearch commentStamp: '' prior: 0! + + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +! + +!CodeSearch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +condition + ^condition +! ! + +!CodeSearch methodsFor: 'condition' stamp: 'KenD 28/Jun/2026 13:32:24'! +conditionType: aSymbol + | case | + case := condition matchesCase. + condition := CodeSearchCondition perform: aSymbol asSymbol. + condition matchCase: case +! ! + +!CodeSearch methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +defaultCondition + ^CodeSearchCondition beginning matchCase: true +! ! + +!CodeSearch methodsFor: 'condition' stamp: 'KenD 28/Jun/2026 13:32:24'! +ignoreCase: aBoolean + condition matchCase: aBoolean not +! ! + +!CodeSearch methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +includes: aString + ^condition evaluateWith: aString +! ! + +!CodeSearch methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + condition := self defaultCondition. + results := OrderedCollection new. + self sortBySize +! ! + +!CodeSearch methodsFor: 'condition' stamp: 'KenD 28/Jun/2026 13:32:24'! +matchCase: aBoolean + condition matchCase: aBoolean +! ! + +!CodeSearch methodsFor: 'condition' stamp: 'KenD 28/Jun/2026 13:32:24'! +pattern: aString + condition := CodeSearchCondition matching: aString +! ! + +!CodeSearch methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:32:24'! +rawResults + ^results +! ! + +!CodeSearch methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +reset + results removeAll +! ! + +!CodeSearch methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +search + self subclassResponsibility +! ! + +!CodeSearch methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +search: aString + condition text: aString. + self reset; search. + condition isSimilarity + ifTrue: [sorter := [:r1 :r2 | (condition text editDistanceTo: r1 text) + <= (condition text editDistanceTo: r2 text)]]. + ^self sortedResults +! ! + +!CodeSearch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sortAlphabetically + sorter := [:r1 :r2 | r1 text <= r2 text] +! ! + +!CodeSearch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sortBySize + sorter := [:r1 :r2 | r1 text size <= r2 text size] +! ! + +!CodeSearch methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:32:24'! +sortedResults + ^sorter ifNil: [results] ifNotNil: [results sortBy: sorter] +! ! + +!CodeSearch methodsFor: 'condition' stamp: 'KenD 28/Jun/2026 13:32:24'! +text: aString + condition text: aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CodeSearch class' category: #Development! +CodeSearch class + instanceVariableNames: ''! + +!CodeSearch class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +search: aString + " + SelectorSearch search: 'abc' + " + ^self new search: aString +! ! + +!CodeSearch class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +search: text in: type + " + CodeSearch search: 'abc' in: 'all' + " + ^self search: text in: type ignoreCase: false conditionType: #beginning +! ! + +!CodeSearch class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +search: text in: type ignoreCase: ignoreCase conditionType: conditionType + " + CodeSearch search: 'a' in: 'all' ignoreCase: true position: #beginning + " + ^(self searchClassesFor: type) gather: [:c | + c new + ignoreCase: ignoreCase; + conditionType: conditionType; + search: text] +! ! + +!CodeSearch class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +searchClassesFor: type + " + CodeSearch searchClassesFor: 'all' + CodeSearch searchClassesFor: 'implementors' + " + ^type = 'all' + ifTrue: [{ClassSearch. SelectorSearch. ProjectSearch. PoolSearch}] + ifFalse: [self subclasses select: [:c | c type = type]] +! ! + +!CodeSearch class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +subclassesToSearch + ^subclasses copyWithout: ImplementorSearch +! ! + +!CodeSearch class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +type + " + CodeSearch type => 'all' + ClassSearch type => 'classes' + " + ^self == CodeSearch + ifTrue: ['all'] + ifFalse: [(self name trimTail: 'Search') asLowercase] +! ! + + +CodeSearch initialize! + diff --git a/modules/Development/CodeSearchCondition.Class.st b/modules/Development/CodeSearchCondition.Class.st new file mode 100644 index 00000000..4286f6b3 --- /dev/null +++ b/modules/Development/CodeSearchCondition.Class.st @@ -0,0 +1,132 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #CodeSearchCondition category: #Development! +Object subclass: #CodeSearchCondition + instanceVariableNames: 'text matchCase' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!CodeSearchCondition commentStamp: '' prior: 0! + + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +! + +!CodeSearchCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +compare: aString + self subclassResponsibility +! ! + +!CodeSearchCondition methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:32:24'! +evaluateWith: aString + | string | + string := matchCase ifTrue: [aString] ifFalse: [aString asLowercase]. + ^self compare: string +! ! + +!CodeSearchCondition methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + matchCase := true +! ! + +!CodeSearchCondition methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isEmpty + ^text isEmptyOrNil +! ! + +!CodeSearchCondition methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isExactMatch + ^false +! ! + +!CodeSearchCondition methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isSimilarity + ^false +! ! + +!CodeSearchCondition methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +matchCase: aBoolean + matchCase := aBoolean +! ! + +!CodeSearchCondition methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +matchesCase + ^matchCase +! ! + +!CodeSearchCondition methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + | case | + case := matchCase ifTrue: ['sensitive'] ifFalse: ['insensitive']. + aStream + nextPutAll: self proposition; + space; + nextPutAll: (text ifNil: ''); + nextPutAll: ' (case ' , case , ')' +! ! + +!CodeSearchCondition methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +text + ^text +! ! + +!CodeSearchCondition methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +text: aString + text := matchCase ifTrue: [aString] ifFalse: [aString asLowercase] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CodeSearchCondition class' category: #Development! +CodeSearchCondition class + instanceVariableNames: ''! + +!CodeSearchCondition class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +beginning + ^BeginningCondition new +! ! + +!CodeSearchCondition class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +beginningWith: aString + ^self beginning text: aString +! ! + +!CodeSearchCondition class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +ending + ^EndingCondition new +! ! + +!CodeSearchCondition class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +endingWith: aString + ^self ending text: aString +! ! + +!CodeSearchCondition class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +exact + ^ExactMatchCondition new +! ! + +!CodeSearchCondition class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +including + ^IncludingCondition new +! ! + +!CodeSearchCondition class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +including: aString + ^self including text: aString +! ! + +!CodeSearchCondition class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +matching: aString + ^PatternCondition new text: aString +! ! + +!CodeSearchCondition class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +similar + ^SimilarityCondition new +! ! + + +CodeSearchCondition initialize! + diff --git a/modules/Development/CodeSearchResult.Class.st b/modules/Development/CodeSearchResult.Class.st new file mode 100644 index 00000000..ea6725e6 --- /dev/null +++ b/modules/Development/CodeSearchResult.Class.st @@ -0,0 +1,80 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #CodeSearchResult category: #Development! +Object subclass: #CodeSearchResult + instanceVariableNames: 'type contents' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!CodeSearchResult commentStamp: '' prior: 0! + + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +! + +!CodeSearchResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +contents + ^contents +! ! + +!CodeSearchResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +contents: anObject + contents := anObject +! ! + +!CodeSearchResult methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + aStream + print: type; + nextPut: $:; + space; + print: contents +! ! + +!CodeSearchResult methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:32:24'! +text + ^contents asString +! ! + +!CodeSearchResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +type + ^type +! ! + +!CodeSearchResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +type: aSymbol + type := aSymbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CodeSearchResult class' category: #Development! +CodeSearchResult class + instanceVariableNames: ''! + +!CodeSearchResult class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +class: aClass + ^self new type: #class; contents: aClass +! ! + +!CodeSearchResult class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +method: aCompiledMethod + ^self new type: #method; contents: aCompiledMethod +! ! + +!CodeSearchResult class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +pool: aString + ^self new type: #pool; contents: aString +! ! + +!CodeSearchResult class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +project: aBeeProject + ^self new type: #project; contents: aBeeProject +! ! + +!CodeSearchResult class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +selector: aSymbol + ^self new type: #selector; contents: aSymbol +! ! + + diff --git a/modules/Development/CompiledMethod.Extension.st b/modules/Development/CompiledMethod.Extension.st new file mode 100644 index 00000000..6ba2a5aa --- /dev/null +++ b/modules/Development/CompiledMethod.Extension.st @@ -0,0 +1,36 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! + + +!CompiledMethod methodsFor: '*Development' stamp: 'KenD 28/Jun/2026 13:32:24'! +ast + ^nil +! ! + +!CompiledMethod methodsFor: '*Development' stamp: 'KenD 28/Jun/2026 13:32:24'! +references: anObject + | literal | + 1 to: self size do: [:i | + literal := self at: i. + anObject = literal ifTrue: [^true]. + (self literal: literal includes: anObject) ifTrue: [^true]]. + ^false +! ! + +!CompiledMethod methodsFor: '*Development' stamp: 'KenD 28/Jun/2026 13:32:24'! +literal: literal includes: anObject + ^literal class == Array and: [ + (literal includes: anObject) + or: [literal anySatisfy: [:l | self literal: l includes: anObject]]] +! ! + +!CompiledMethod methodsFor: '*Development' stamp: 'KenD 28/Jun/2026 13:32:24'! +treecodeString + ^treecodes printString +! ! + +!CompiledMethod class methodsFor: '*Development' stamp: 'KenD 28/Jun/2026 13:32:24'! +aspects + ^#(#treecodeString #disassembledText) +! ! + + diff --git a/modules/Development/DevelopmentModule.Class.st b/modules/Development/DevelopmentModule.Class.st new file mode 100644 index 00000000..cf893b55 --- /dev/null +++ b/modules/Development/DevelopmentModule.Class.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #DevelopmentModule category: #Webside! +Module subclass: #DevelopmentModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Webside'! +!DevelopmentModule commentStamp: '' prior: 0! + + Copyright (c) 2025, Javier Pimás. + See (MIT) license in root directory. +! + +!DevelopmentModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +imports + ^{ + #Kernel -> #(ProtoObject) + } +! ! + +!DevelopmentModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:32:24'! +main: arguments + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'DevelopmentModule class' category: #Webside! +DevelopmentModule class + instanceVariableNames: ''! + + diff --git a/modules/Development/EndingCondition.Class.st b/modules/Development/EndingCondition.Class.st new file mode 100644 index 00000000..d0fe4cc1 --- /dev/null +++ b/modules/Development/EndingCondition.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #EndingCondition category: #Development! +CodeSearchCondition subclass: #EndingCondition + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!EndingCondition commentStamp: '' prior: 0! + + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +! + +!EndingCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +compare: aString + ^aString endsWith: text +! ! + +!EndingCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +proposition + ^'ends with' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'EndingCondition class' category: #Development! +EndingCondition class + instanceVariableNames: ''! + + diff --git a/modules/Development/ExactMatchCondition.Class.st b/modules/Development/ExactMatchCondition.Class.st new file mode 100644 index 00000000..a840e74c --- /dev/null +++ b/modules/Development/ExactMatchCondition.Class.st @@ -0,0 +1,36 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #ExactMatchCondition category: #Development! +CodeSearchCondition subclass: #ExactMatchCondition + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!ExactMatchCondition commentStamp: '' prior: 0! + + Copyright (c) 202, Quorum Software. + See (MIT) license in root directory. +! + +!ExactMatchCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +compare: aString + ^aString = text +! ! + +!ExactMatchCondition methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isExactMatch + ^true +! ! + +!ExactMatchCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +proposition + ^'equals' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExactMatchCondition class' category: #Development! +ExactMatchCondition class + instanceVariableNames: ''! + + diff --git a/modules/Development/IncludingCondition.Class.st b/modules/Development/IncludingCondition.Class.st new file mode 100644 index 00000000..ce90df3a --- /dev/null +++ b/modules/Development/IncludingCondition.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #IncludingCondition category: #Development! +CodeSearchCondition subclass: #IncludingCondition + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!IncludingCondition commentStamp: '' prior: 0! + + Copyright (c) 202,5 Quorum Software. + See (MIT) license in root directory. +! + +!IncludingCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +compare: aString + ^aString includesString: text +! ! + +!IncludingCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +proposition + ^'includes' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IncludingCondition class' category: #Development! +IncludingCondition class + instanceVariableNames: ''! + + diff --git a/modules/Development/MethodSearch.Class.st b/modules/Development/MethodSearch.Class.st new file mode 100644 index 00000000..0b35b7df --- /dev/null +++ b/modules/Development/MethodSearch.Class.st @@ -0,0 +1,190 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #MethodSearch category: #Development! +CodeSearch subclass: #MethodSearch + instanceVariableNames: 'scope next' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!MethodSearch commentStamp: '' prior: 0! + + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +! + +!MethodSearch methodsFor: 'combining' stamp: 'KenD 28/Jun/2026 13:32:24'! +& aMethodSearch + self class == MethodSearch ifTrue: [ + scope isDefault ifFalse: [aMethodSearch scope: scope]. + ^aMethodSearch]. + next notNil ifTrue: [next & aMethodSearch] ifFalse: [next := aMethodSearch] +! ! + +!MethodSearch methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +addResult: aCompiledMethod + | m | + m := next notNil + ifTrue: [aCompiledMethod] + ifFalse: [CodeSearchResult method: aCompiledMethod]. + results add: m +! ! + +!MethodSearch methodsFor: 'scope' stamp: 'KenD 28/Jun/2026 13:32:24'! +amongMethods: aCollection + scope := aCollection +! ! + +!MethodSearch methodsFor: 'combining' stamp: 'KenD 28/Jun/2026 13:32:24'! +assigningVariable: aString + ^self & (self class assigningVariable: aString) +! ! + +!MethodSearch methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +defaultScope + ^MethodSearchScope default +! ! + +!MethodSearch methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +doSearch + scope methods do: [:m | self addResult: m] +! ! + +!MethodSearch methodsFor: 'scope' stamp: 'KenD 28/Jun/2026 13:32:24'! +inClass: class + scope := MethodSearchScope class: class +! ! + +!MethodSearch methodsFor: 'scope' stamp: 'KenD 28/Jun/2026 13:32:24'! +includeClassSide: aBoolean + scope includeClassSide: aBoolean +! ! + +!MethodSearch methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + scope := self defaultScope +! ! + +!MethodSearch methodsFor: 'scope' stamp: 'KenD 28/Jun/2026 13:32:24'! +inProject: project + scope := MethodSearchScope project: project +! ! + +!MethodSearch methodsFor: 'combining' stamp: 'KenD 28/Jun/2026 13:32:24'! +referencingClass: aClass + ^self & (self class referencingClass: aClass) +! ! + +!MethodSearch methodsFor: 'combining' stamp: 'KenD 28/Jun/2026 13:32:24'! +referencingString: aString + ^self & (self class referencingString: aString) +! ! + +!MethodSearch methodsFor: 'combining' stamp: 'KenD 28/Jun/2026 13:32:24'! +referencingVariable: aString + ^self & (self class referencingVariable: aString) +! ! + +!MethodSearch methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +scope + ^scope +! ! + +!MethodSearch methodsFor: 'scope' stamp: 'KenD 28/Jun/2026 13:32:24'! +scope: aMethodSearchScope + scope := aMethodSearchScope +! ! + +!MethodSearch methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +search + self reset; doSearch. + ^next notNil + ifTrue: [next amongMethods: results; search] + ifFalse: [results] +! ! + +!MethodSearch methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +searchEvaluating: aBlock + scope do: [:m | (aBlock value: m) ifTrue: [self addResult: m]]. + ^results +! ! + +!MethodSearch methodsFor: 'combining' stamp: 'KenD 28/Jun/2026 13:32:24'! +sending: aSymbol + ^self & (self class sending: aSymbol) +! ! + +!MethodSearch methodsFor: 'combining' stamp: 'KenD 28/Jun/2026 13:32:24'! +underCategory: aString + ^self & (self class underCategory: aString) +! ! + +!MethodSearch methodsFor: 'combining' stamp: 'KenD 28/Jun/2026 13:32:24'! +usingVariable: aString + ^self & (self class usingVariable: aString) +! ! + +!MethodSearch methodsFor: 'combining' stamp: 'KenD 28/Jun/2026 13:32:24'! +withSelector: aSymbol + ^self & (self class withSelector: aSymbol) +! ! + +!MethodSearch methodsFor: 'combining' stamp: 'KenD 28/Jun/2026 13:32:24'! +withSelectorMatching: aString + ^self & (self class withSelectorMatching: aString) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MethodSearch class' category: #Development! +MethodSearch class + instanceVariableNames: ''! + +!MethodSearch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +assigningVariable: aString + ^VariableAccessSearch new type: #assign; text: aString +! ! + +!MethodSearch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +referencingClass: aClass + ^ClassReferenceSearch new text: aClass name +! ! + +!MethodSearch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +referencingString: aString + ^StringReferenceSearch new text: aString +! ! + +!MethodSearch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +referencingVariable: aString + ^VariableAccessSearch new type: #reference; text: aString +! ! + +!MethodSearch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +sending: aSymbol + ^SenderSearch new text: aSymbol +! ! + +!MethodSearch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +underCategory: aString + ^CategorySearch new text: aString +! ! + +!MethodSearch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +usingVariable: aString + ^VariableAccessSearch new type: #use; text: aString +! ! + +!MethodSearch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +withSelector: aSymbol + ^ImplementorSearch new text: aSymbol +! ! + +!MethodSearch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +withSelectorMatching: aString + ^ImplementorSearch new pattern: aString +! ! + + +MethodSearch initialize! + diff --git a/modules/Development/MethodSearchScope.Class.st b/modules/Development/MethodSearchScope.Class.st new file mode 100644 index 00000000..5d8c6372 --- /dev/null +++ b/modules/Development/MethodSearchScope.Class.st @@ -0,0 +1,181 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #MethodSearchScope category: #Development! +Object subclass: #MethodSearchScope + instanceVariableNames: 'class hierarchy project classSide' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!MethodSearchScope commentStamp: '' prior: 0! + + Copyright (c) 2025, Quorum Software. + See (MIT) license in root directory. +! + +!MethodSearchScope methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:32:24'! += aMethodSearchScope + ^self class == aMethodSearchScope class + and: [class == aMethodSearchScope targetClass] + and: [hierarchy == aMethodSearchScope targetHierarchy] + and: [project == aMethodSearchScope targetProject] + and: [classSide == aMethodSearchScope includesClassSide] +! ! + +!MethodSearchScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +class: aClass + class := aClass. + hierarchy := project := nil +! ! + +!MethodSearchScope methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:32:24'! +classesDo: aBlock + class notNil ifTrue: [^aBlock value: class]. + hierarchy notNil + ifTrue: [^hierarchy allSuperclasses reversed , hierarchy withAllSubclasses + do: aBlock]. + project notNil ifTrue: [^project classes do: aBlock] +! ! + +!MethodSearchScope methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:32:24'! +collect: aBlock + | result | + result := OrderedCollection new. + self do: [:m | result add: (aBlock evaluateWith: m)]. + ^result +! ! + +!MethodSearchScope methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:32:24'! +do: aBlock + self methodsDo: aBlock +! ! + +!MethodSearchScope methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:32:24'! +hash + ^self class hashWith: class with: hierarchy with: project with: classSide +! ! + +!MethodSearchScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +hierarchy: aClass + hierarchy := aClass. + class := project := nil +! ! + +!MethodSearchScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +includeClassSide: aBoolean + classSide := aBoolean +! ! + +!MethodSearchScope methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +includesClassSide + ^classSide +! ! + +!MethodSearchScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + classSide := true. + hierarchy := ProtoObject +! ! + +!MethodSearchScope methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isDefault + ^self = self class default +! ! + +!MethodSearchScope methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:32:24'! +methods + | methods | + methods := OrderedCollection new. + self methodsDo: [:m | methods add: m]. + ^methods +! ! + +!MethodSearchScope methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:32:24'! +methodsDo: aBlock + project notNil ifTrue: [^project allMethods do: aBlock]. + self classesDo: [:c | + c methodDictionary values do: aBlock. + classSide ifTrue: [c class methodDictionary values do: aBlock]] +! ! + +!MethodSearchScope methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + class notNil ifTrue: [ + aStream + nextPutAll: 'Methods in '; + print: class; + nextPutAll: ' class'. + ^self]. + hierarchy notNil ifTrue: [ + aStream + nextPutAll: 'Methods in '; + print: hierarchy; + nextPutAll: ' hierarhcy'. + ^self]. + project notNil ifTrue: [ + aStream + nextPutAll: 'Methods in '; + print: project; + nextPutAll: ' project'. + ^self]. + super printOn: aStream +! ! + +!MethodSearchScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +project: aBeeProject + project := aBeeProject. + hierarchy := class := nil +! ! + +!MethodSearchScope methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:32:24'! +select: aBlock + | result | + result := OrderedCollection new. + self do: [:m | (aBlock evaluateWith: m) ifTrue: [result add: m]]. + ^result +! ! + +!MethodSearchScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +targetClass + ^class +! ! + +!MethodSearchScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +targetHierarchy + ^hierarchy +! ! + +!MethodSearchScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +targetProject + ^project +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MethodSearchScope class' category: #Development! +MethodSearchScope class + instanceVariableNames: ''! + +!MethodSearchScope class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +class: aClass + ^self new class: aClass +! ! + +!MethodSearchScope class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +default + ^self hierarchy: ProtoObject +! ! + +!MethodSearchScope class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +hierarchy: aClass + ^self new hierarchy: aClass +! ! + +!MethodSearchScope class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +project: aBeeProject + ^self new project: aBeeProject +! ! + + +MethodSearchScope initialize! + diff --git a/modules/Development/PatternCondition.Class.st b/modules/Development/PatternCondition.Class.st new file mode 100644 index 00000000..820b28c3 --- /dev/null +++ b/modules/Development/PatternCondition.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PatternCondition category: #Development! +CodeSearchCondition subclass: #PatternCondition + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!PatternCondition commentStamp: '' prior: 0! + + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +! + +!PatternCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +compare: aString + ^text match: aString +! ! + +!PatternCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +proposition + ^'matches' +! ! + +!PatternCondition methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +text: aString + | string | + string := aString trimBlanks. + string := matchCase ifTrue: [aString] ifFalse: [aString asLowercase]. + string first !!= $* ifTrue: [string := '*' , string]. + string last !!= $* ifTrue: [string := string , '*']. + super text: string +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PatternCondition class' category: #Development! +PatternCondition class + instanceVariableNames: ''! + + diff --git a/modules/Development/SimilarityCondition.Class.st b/modules/Development/SimilarityCondition.Class.st new file mode 100644 index 00000000..e5d0825e --- /dev/null +++ b/modules/Development/SimilarityCondition.Class.st @@ -0,0 +1,44 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #SimilarityCondition category: #Development! +CodeSearchCondition subclass: #SimilarityCondition + instanceVariableNames: 'tolerance' + classVariableNames: '' + poolDictionaries: '' + category: 'Development'! +!SimilarityCondition commentStamp: '' prior: 0! + + Copyright (c) 2025, Guillermo Amaral, Javier Pimás. + See (MIT) license in root directory. +! + +!SimilarityCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +compare: aString + ^(aString editDistanceTo: text) <= tolerance +! ! + +!SimilarityCondition methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + tolerance := 3 +! ! + +!SimilarityCondition methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isSimilarity + ^true +! ! + +!SimilarityCondition methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +proposition + ^'is similar to' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SimilarityCondition class' category: #Development! +SimilarityCondition class + instanceVariableNames: ''! + + +SimilarityCondition initialize! + diff --git a/modules/EPM/Config.Class.st b/modules/EPM/Config.Class.st new file mode 100644 index 00000000..59bc8b04 --- /dev/null +++ b/modules/EPM/Config.Class.st @@ -0,0 +1,133 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #Config category: #EPM! +Object subclass: #Config + instanceVariableNames: 'project user merged' + classVariableNames: '' + poolDictionaries: '' + category: 'EPM'! +!Config commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: aString + ^merged at: aString ifAbsent: [nil] +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: aString ifAbsent: aBlock + ^merged at: aString ifAbsent: aBlock +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +dependencies + ^self at: 'dependencies' ifAbsent: [OrderedDictionary new] +! ! + +!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +load + self loadUser. + self loadProject. + self merge +! ! + +!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadProject + | cwd path contents | + cwd := Kernel currentDirectory. + path := cwd, '/epm.toml'. + (Kernel pathExists: path) + ifTrue: [ + contents := Kernel readFile: path. + project := TOMLParser parse: contents] + ifFalse: [project := OrderedDictionary new] +! ! + +!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadUser + | home path contents | + home := Kernel getEnv: 'HOME'. + home ifNil: [user := OrderedDictionary new. ^self]. + path := home, '/.egg/config.toml'. + (Kernel pathExists: path) + ifTrue: [ + contents := Kernel readFile: path. + user := TOMLParser parse: contents] + ifFalse: [user := OrderedDictionary new] +! ! + +!Config methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +merge + merged := OrderedDictionary new. + self mergeFrom: user into: merged. + self mergeFrom: project into: merged +! ! + +!Config methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +mergeFrom: aSource into: aTarget + aSource keysAndValuesDo: [:k :v | + | existing | + existing := aTarget at: k ifAbsent: [nil]. + (v isKindOf: OrderedDictionary) + ifTrue: [ + (existing isKindOf: OrderedDictionary) + ifTrue: [self mergeFrom: v into: existing] + ifFalse: [ + | copy | + copy := OrderedDictionary new. + self mergeFrom: v into: copy. + aTarget at: k put: copy]] + ifFalse: [aTarget at: k put: v]] +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +modulePaths + | paths section | + paths := self at: 'paths'. + paths ifNil: [^#()]. + section := paths at: 'modules' ifAbsent: [nil]. + section ifNil: [^#()]. + ^section +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + | section | + section := self at: 'project'. + section ifNil: [^nil]. + ^section at: 'name' ifAbsent: [nil] +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +project + ^project +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +user + ^user +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +version + | section | + section := self at: 'project'. + section ifNil: [^nil]. + ^section at: 'version' ifAbsent: [nil] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Config class' category: #EPM! +Config class + instanceVariableNames: ''! + +!Config class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +load + ^self new load +! ! + + diff --git a/modules/EPM/EPMModule.Class.st b/modules/EPM/EPMModule.Class.st new file mode 100644 index 00000000..e48cb17d --- /dev/null +++ b/modules/EPM/EPMModule.Class.st @@ -0,0 +1,184 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #EPMModule category: #EPM! +Module subclass: #EPMModule + instanceVariableNames: 'args parser config' + classVariableNames: '' + poolDictionaries: '' + category: 'EPM'! +!EPMModule commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +addCommand: aString description: aDescription action: aSymbol + | command | + command := Command new + name: aString; + description: aDescription. + command action: [:result | self perform: aSymbol with: result]. + parser addCommand: command. + ^command +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandDev: aResult + | cwd name dev module | + cwd := Kernel currentDirectory. + name := cwd copyAfterLast: $/. + dev := Kernel load: #Development. + module := Kernel load: name asSymbol. + dev main: args +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandInit: aResult + | cwd name generator | + cwd := Kernel currentDirectory. + name := cwd copyAfterLast: $/. + name isEmpty ifTrue: [name := 'myproject']. + generator := ProjectGenerator new. + generator name: name. + generator dir: cwd. + generator generateToml. + Kernel log: 'Initialized epm.toml for: ', name +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandInstall: aResult + | dependencies | + config ifNil: [self loadConfig]. + dependencies := config dependencies. + dependencies isEmpty ifTrue: [ + Kernel log: 'No dependencies to install'. + ^self]. + Kernel log: 'Installing dependencies...'. + dependencies keysAndValuesDo: [:name :constraint | + Kernel log: ' ', name, ' (', constraint asString, ')']. + Kernel log: 'Done' +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandList: aResult + | dependencies | + config ifNil: [self loadConfig]. + dependencies := config dependencies. + dependencies isEmpty ifTrue: [ + Kernel log: 'No dependencies'. + ^self]. + Kernel log: config name ifNil: ['(unnamed project)']. + dependencies keysAndValuesDo: [:name :constraint | + Kernel log: ' ', name, ' ', constraint asString] +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandNew: aResult + | name generator | + aResult positionals isEmpty ifTrue: [ + ^self error: 'Usage: epm new ']. + name := aResult positionalAt: 1. + generator := ProjectGenerator new. + generator name: name. + generator generate. + Kernel log: 'Created project: ', name +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandStart: aResult + | cwd name module | + cwd := Kernel currentDirectory. + name := cwd copyAfterLast: $/. + module := Kernel load: name asSymbol. + module main: args +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandTest: aResult + | name module positionals | + positionals := aResult positionals. + name := positionals isEmpty + ifTrue: [self projectName] + ifFalse: [positionals first]. + name ifNil: [ + ^self error: 'Usage: epm test [module-name]']. + module := Kernel load: (name, '.Tests') asSymbol. + (aResult optionAt: 'debug') == true + ifTrue: [self debugTestModule: module] + ifFalse: [module main: args] +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +debugTestModule: aModule + Kernel log: 'Running ', aModule name, ' tests in debug mode...'; log: String cr. + (TestSuite forModule: aModule) runDebug. + Kernel log: 'Done.'; log: String cr +! ! + +!EPMModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! +imports + ^{ + #Kernel -> #(Error OrderedDictionary). + #ArgParser -> #(ArgParser Command Option). + #SUnit -> #(TestSuite). + #TOML -> #(TOMLParser TOMLWriter). + } +! ! + +!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadConfig + | host | + config := Config load. + host := Kernel host. + config modulePaths do: [:path | + host prependSearchPath: path type: #tonel. + host prependSearchPath: path type: #ems] +! ! + +!EPMModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:40'! +main: aCollection + | params | + args := aCollection. + self loadConfig. + self setupParser. + params := OrderedCollection new. + 3 to: args size do: [:i | + | arg | + arg := args at: i. + params add: arg]. + parser parse: params asArray +! ! + +!EPMModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +projectName + ^config ifNotNil: [config name] +! ! + +!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +setupParser + | create | + parser := ArgParser new name: 'epm'; description: 'Egg Package Manager'. + create := self addCommand: 'new' description: 'Create a new project' action: #commandNew:. + create addPositional: 'name'. + self addCommand: 'init' description: 'Initialize epm.toml in current directory' action: #commandInit:. + self addCommand: 'start' description: 'Run current project' action: #commandStart:. + self addCommand: 'dev' description: 'Start development environment for current project' action: #commandDev:. + self addCommand: 'install' description: 'Install dependencies from epm.toml' action: #commandInstall:. + self addCommand: 'list' description: 'List project dependencies' action: #commandList:. + ((self addCommand: 'test' description: 'Run tests for a module' action: #commandTest:) + addPositional: 'module'; + addOption: (Option new + long: '--debug'; + description: 'Run tests without swallowing exceptions'; + beFlag; + yourself)) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'EPMModule class' category: #EPM! +EPMModule class + instanceVariableNames: ''! + + diff --git a/modules/EPM/ProjectGenerator.Class.st b/modules/EPM/ProjectGenerator.Class.st new file mode 100644 index 00000000..3ac46568 --- /dev/null +++ b/modules/EPM/ProjectGenerator.Class.st @@ -0,0 +1,96 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ProjectGenerator category: #EPM! +Object subclass: #ProjectGenerator + instanceVariableNames: 'name dir' + classVariableNames: '' + poolDictionaries: '' + category: 'EPM'! +!ProjectGenerator commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +dir: aString + dir := aString +! ! + +!ProjectGenerator methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +ensureDir + dir ifNil: [ + dir := Kernel currentDirectory, '/', name]. + Kernel createDirectory: dir +! ! + +!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026 13:27:40'! +generate + | modules module | + self ensureDir. + modules := dir, '/modules'. + module := modules, '/', self moduleName. + Kernel createDirectory: modules. + Kernel createDirectory: module. + self generateToml. + self generateModule: module +! ! + +!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026 13:27:40'! +generateModule: aString + | filename contents module | + module := self moduleName. + filename := aString, '/', module, 'Module.st'. + contents := '" + See (MIT) license in root directory. +" + +Class { + #name : #', module, 'Module, + #superclass : #Module, + #instVars : [], + #category : #', module, ' +} + +{ #category : #main } +', module, 'Module >> main: args [ + Kernel log: ''Hello from ', name, ''' +] +'. + Kernel writeFile: filename contents: contents +! ! + +!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026 13:27:40'! +generateToml + | filename contents | + self ensureDir. + filename := dir, '/epm.toml'. + contents := '[project] +name = "', name, '" +version = "0.1.0" +description = "" + +[dependencies] +'. + Kernel writeFile: filename contents: contents +! ! + +!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +moduleName + | first | + first := name first asUppercase. + ^(String with: first), (name copyFrom: 2) +! ! + +!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name: aString + name := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ProjectGenerator class' category: #EPM! +ProjectGenerator class + instanceVariableNames: ''! + + diff --git a/modules/Examples/HTTPServer/ExampleAPI.Class.st b/modules/Examples/HTTPServer/ExampleAPI.Class.st new file mode 100644 index 00000000..6abeca7f --- /dev/null +++ b/modules/Examples/HTTPServer/ExampleAPI.Class.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ExampleAPI category: #'Examples-HTTPServer'! +Object subclass: #ExampleAPI + instanceVariableNames: 'request response' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-HTTPServer'! +!ExampleAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +hello + | name | + name := request paramAt: 'name'. + name isEmpty ifTrue: [name := 'world']. + response setContents: 'hello, ', name, '!!' type: 'text/html' +! ! + +!ExampleAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +request: aRequest + request := aRequest +! ! + +!ExampleAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +response: aResponse + response := aResponse +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExampleAPI class' category: #'Examples-HTTPServer'! +ExampleAPI class + instanceVariableNames: ''! + + diff --git a/modules/Examples/HTTPServer/HTTPServerModule.Class.st b/modules/Examples/HTTPServer/HTTPServerModule.Class.st new file mode 100644 index 00000000..d9236800 --- /dev/null +++ b/modules/Examples/HTTPServer/HTTPServerModule.Class.st @@ -0,0 +1,46 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #HTTPServerModule category: #'Examples-HTTPServer'! +Module subclass: #HTTPServerModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-HTTPServer'! +!HTTPServerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #FFI -> #(ExternalLibrary). + #'HTTP.CPPHTTPServer' -> #(HTTPServer). + } +! ! + +!HTTPServerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +handle: request into: response with: selector + | api | + api := ExampleAPI new + request: request; + response: response. + api perform: selector. + "response headersAt: 'Access-Control-Allow-Origin' put: '*'." +! ! + +!HTTPServerModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +main: arguments + | server base | + ExternalLibrary module initializeForCurrentPlatform. + base := arguments at: 3 ifAbsent: ['/egg']. + server := HTTPServer new. + server + routeGET: base, '/hello/{name}' to: [:req :res | self handle: req into: res with: #hello]. + Kernel log: 'server configured, starting!!', String cr. + server start. + ^0 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HTTPServerModule class' category: #'Examples-HTTPServer'! +HTTPServerModule class + instanceVariableNames: ''! + + diff --git a/modules/Examples/HelloWorld/HelloWorldModule.Class.st b/modules/Examples/HelloWorld/HelloWorldModule.Class.st new file mode 100644 index 00000000..9ecbae7f --- /dev/null +++ b/modules/Examples/HelloWorld/HelloWorldModule.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #HelloWorldModule category: #'Examples-HelloWorld'! +Module subclass: #HelloWorldModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-HelloWorld'! +!HelloWorldModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{} +! ! + +!HelloWorldModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +main: arguments + Kernel log: 'Hello, World!!', String cr. + ^0 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HelloWorldModule class' category: #'Examples-HelloWorld'! +HelloWorldModule class + instanceVariableNames: ''! + + diff --git a/modules/Examples/PrintClasses/PrintClassesModule.Class.st b/modules/Examples/PrintClasses/PrintClassesModule.Class.st new file mode 100644 index 00000000..bdce0880 --- /dev/null +++ b/modules/Examples/PrintClasses/PrintClassesModule.Class.st @@ -0,0 +1,37 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PrintClassesModule category: #'Examples-PrintClasses'! +Module subclass: #PrintClassesModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Examples-PrintClasses'! +!PrintClassesModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{} +! ! + +!PrintClassesModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +printAClass: aClass indent: indentCount + | aString | + indentCount timesRepeat: [ + Kernel log: ' '. + ]. + Kernel log: aClass printString, String cr. + aClass subclassesDo: [ :sub | self printAClass: sub indent: indentCount + 1 ]. +! ! + +!PrintClassesModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +main: arguments + Kernel log: 'Current Local Classes', String cr. + self printAClass: Object class indent: 0. + ^0 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PrintClassesModule class' category: #'Examples-PrintClasses'! +PrintClassesModule class + instanceVariableNames: ''! + + diff --git a/modules/FFI/ByteArray.Extension.st b/modules/FFI/ByteArray.Extension.st new file mode 100644 index 00000000..5fd2bd91 --- /dev/null +++ b/modules/FFI/ByteArray.Extension.st @@ -0,0 +1,24 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!ByteArray methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:37'! +copyToMemory: anExternalMemory + anExternalMemory replaceFrom: 1 to: self size with: self startingAt: 1 +! ! + +!ByteArray methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:37'! +externalCopy + ^ExternalMemory fromByteArray: self +! ! + +!ByteArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:37'! +pointedMemory + ^ExternalMemory at: self +! ! + +!ByteArray class methodsFor: '*instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +fromMemory: anExternalMemory length: anInteger + ^self fromBytes: anExternalMemory length: anInteger +! ! + + diff --git a/modules/FFI/ByteArraySegment.Extension.st b/modules/FFI/ByteArraySegment.Extension.st new file mode 100644 index 00000000..e17579bd --- /dev/null +++ b/modules/FFI/ByteArraySegment.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +externalCopy + ^ExternalMemory fromByteArray: self asByteArray +! ! + + diff --git a/modules/FFI/CallbackBehavior.Class.st b/modules/FFI/CallbackBehavior.Class.st new file mode 100644 index 00000000..7a981e4a --- /dev/null +++ b/modules/FFI/CallbackBehavior.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #CallbackBehavior category: #FFI! +Behavior subclass: #CallbackBehavior + instanceVariableNames: 'nativeCode' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!CallbackBehavior commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!CallbackBehavior methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +nativeCode + ^nativeCode +! ! + +!CallbackBehavior methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +nativeCode: aNativeCode + nativeCode := aNativeCode +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CallbackBehavior class' category: #FFI! +CallbackBehavior class + instanceVariableNames: ''! + + diff --git a/modules/FFI/CallbackMethod.Class.st b/modules/FFI/CallbackMethod.Class.st new file mode 100644 index 00000000..eaa85426 --- /dev/null +++ b/modules/FFI/CallbackMethod.Class.st @@ -0,0 +1,46 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #CallbackMethod category: #FFI! +CompiledMethod subclass: #CallbackMethod + instanceVariableNames: 'receiver descriptor' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!CallbackMethod commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!CallbackMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +descriptor + ^descriptor +! ! + +!CallbackMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +descriptor: anFFIDescriptor + descriptor := anFFIDescriptor +! ! + +!CallbackMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isCallback + ^true +! ! + +!CallbackMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +receiver + ^receiver +! ! + +!CallbackMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +receiver: anObject + receiver := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CallbackMethod class' category: #FFI! +CallbackMethod class + instanceVariableNames: ''! + + diff --git a/modules/FFI/CharacterArray.Extension.st b/modules/FFI/CharacterArray.Extension.st new file mode 100644 index 00000000..ba06e1df --- /dev/null +++ b/modules/FFI/CharacterArray.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!CharacterArray methodsFor: 'ffi' stamp: 'KenD 28/Jun/2026 13:27:37'! +externalCopy + ^OS externalCopyOfString: self +! ! + + diff --git a/modules/FFI/ExternalHandle.Class.st b/modules/FFI/ExternalHandle.Class.st new file mode 100644 index 00000000..1ae4014e --- /dev/null +++ b/modules/FFI/ExternalHandle.Class.st @@ -0,0 +1,47 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ExternalHandle category: #FFI! +ByteArray subclass: #ExternalHandle + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!ExternalHandle commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!ExternalHandle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +asInteger + ^self pointerAtOffset: 0 +! ! + +!ExternalHandle methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isValid + ^self asInteger !!= 0 +! ! + +!ExternalHandle methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + ^self requireFinalization +! ! + +!ExternalHandle methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +release +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExternalHandle class' category: #FFI! +ExternalHandle class + instanceVariableNames: ''! + +!ExternalHandle class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +new + ^self new: WordSize +! ! + + +ExternalHandle initialize! + diff --git a/modules/FFI/ExternalHeap.Class.st b/modules/FFI/ExternalHeap.Class.st new file mode 100644 index 00000000..e2acf1bf --- /dev/null +++ b/modules/FFI/ExternalHeap.Class.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ExternalHeap category: #FFI! +Object subclass: #ExternalHeap + instanceVariableNames: 'clib' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!ExternalHeap commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. + + I'm an object that represents a dynamic library such as an so, a dll or a dylib +! + +!ExternalHeap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +allocate: anInteger + ^self subclassResponsibility +! ! + +!ExternalHeap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +free: anExternalMemory + ^self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExternalHeap class' category: #FFI! +ExternalHeap class + instanceVariableNames: ''! + + diff --git a/modules/FFI/ExternalLibrary.Class.st b/modules/FFI/ExternalLibrary.Class.st new file mode 100644 index 00000000..2057382c --- /dev/null +++ b/modules/FFI/ExternalLibrary.Class.st @@ -0,0 +1,80 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ExternalLibrary category: #FFI! +Object subclass: #ExternalLibrary + instanceVariableNames: 'handle' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!ExternalLibrary commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. + + I'm an object that represents a dynamic library such as an so, a dll or a dylib +! + +!ExternalLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +address + ^handle pointerAtOffset: 0 +! ! + +!ExternalLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +address: anInteger + handle pointerAtOffset: 0 put: anInteger +! ! + +!ExternalLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +handle + ^handle +! ! + +!ExternalLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +loader + ^ExternalLibrary module loader +! ! + +!ExternalLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + handle := ExternalHandle new +! ! + +!ExternalLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +open + self loader open: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExternalLibrary class' category: #FFI! +ExternalLibrary class + instanceVariableNames: ''! + +!ExternalLibrary class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +filename + ^self loader libraryFilename: self +! ! + +!ExternalLibrary class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +libpath + ^'' +! ! + +!ExternalLibrary class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +linuxFilename + ^'lib', self libname, '.so' +! ! + +!ExternalLibrary class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +macFilename + ^'lib', self libname, '.dylib' +! ! + +!ExternalLibrary class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +windowsFilename + ^self libname, '.dll' +! ! + + +ExternalLibrary initialize! + diff --git a/modules/FFI/ExternalMemory.Class.st b/modules/FFI/ExternalMemory.Class.st new file mode 100644 index 00000000..b60602c9 --- /dev/null +++ b/modules/FFI/ExternalMemory.Class.st @@ -0,0 +1,566 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ExternalMemory category: #FFI! +Object subclass: #ExternalMemory + instanceVariableNames: 'address heap' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!ExternalMemory commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ExternalMemory methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:37'! +- anInteger + ^self + anInteger negated +! ! + +!ExternalMemory methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:37'! ++ anInteger + ^ExternalMemory at: self asInteger + anInteger +! ! + +!ExternalMemory methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:37'! += anExternalMemory + self class == anExternalMemory class ifFalse: [^false]. + ^address = anExternalMemory contents +! ! + +!ExternalMemory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +address: anInteger + address pointerAtOffset: 0 put: anInteger +! ! + +!ExternalMemory methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:37'! +asInteger + ^self asUnsignedInteger +! ! + +!ExternalMemory methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:37'! +asParameter + ^address +! ! + +!ExternalMemory methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:37'! +asUnsignedInteger + ^address pointerAtOffset: 0 +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +at: index + ^self atOffset: index - 1 +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +at: index ifAbsent: aBlock + index > self length ifTrue: [^aBlock value]. + ^self at: index +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +at: index put: byte + ^self atOffset: index - 1 put: byte +! ! + +!ExternalMemory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +atOffset: offset + ^(address _basicAt: 1) _byteAt: offset + 1 +! ! + +!ExternalMemory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +atOffset: offset put: byte + ^(address _basicAt: 1) _byteAt: offset + 1 put: byte +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +byteAt: anInteger + ^self at: anInteger +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +byteAt: anInteger put: byte + ^self at: anInteger put: byte +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +byteAtOffset: anInteger + ^self atOffset: anInteger +! ! + +!ExternalMemory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +bytes + self subclassResponsibility +! ! + +!ExternalMemory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +clear: n + | blank | + blank := ByteArray new: n. + self replaceFrom: 1 to: n with: blank startingAt: 1 +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +contents + ^address +! ! + +!ExternalMemory methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:37'! +copy + ^self shouldNotImplement +! ! + +!ExternalMemory methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:37'! +copyFrom: start to: stop + | size | + size := stop - start + 1. + ^(ByteArray new: size) + replaceFrom: 1 + to: size + with: self + startingAt: start +! ! + +!ExternalMemory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +externalCopy + ^self +! ! + +!ExternalMemory methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:37'! +finalizationRegistry + ^Kernel session resourceRegistry +! ! + +!ExternalMemory methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:37'! +finalize + ^self release +! ! + +!ExternalMemory methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:37'! +free + self release; ignoreFinalization +! ! + +!ExternalMemory methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hash + ^address hash +! ! + +!ExternalMemory methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasBytes + ^true +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +heap + ^heap +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +heap: anExternalHeap + heap := anExternalHeap +! ! + +!ExternalMemory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:37'! +indexOf: byte + | offset | + offset := 0. + [ + (self atOffset: offset) = byte ifTrue: [^offset + 1]. + offset := offset + 1] repeat +! ! + +!ExternalMemory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:37'! +indexOf: byte between: start and: end ifAbsent: aBlock + | index | + index := start. + [index <= end] whileTrue: [ + (self at: index) = byte ifTrue: [^index]. + index := index + 1]. + ^aBlock value +! ! + +!ExternalMemory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:37'! +indexOf: byte startingAt: start ifAbsent: aBlock + ^self indexOf: byte between: start and: self length ifAbsent: aBlock +! ! + +!ExternalMemory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:37'! +indexOfSubcollection: aCollection from: start to: stop td1: aDictionary + | m k | + m := aCollection sizeInBytes. + m = 0 ifTrue: [^0]. + k := start. + [k + m - 1 <= stop] whileTrue: [| i object delta | + i := 1. + [i <= m and: [(aCollection at: i) = (self at: k + i - 1)]] + whileTrue: [i := i + 1]. + i > m ifTrue: [^k]. + k + m > stop ifTrue: [^0]. + object := self at: k + m. + delta := aDictionary at: object ifAbsent: [m + 1]. + delta isNil ifTrue: [delta := m + 1]. + k := k + delta]. + ^0 +! ! + +!ExternalMemory methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + super initialize. + address := ByteArray new: self class sizeInBytes +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +invalidate + address := NullAddress +! ! + +!ExternalMemory methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isExternalMemory + ^true +! ! + +!ExternalMemory methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isValid + ^address !!= NullAddress +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +length + ^nil +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +longAtOffset: offset + offset _isSmallInteger + ifFalse: [^self error: offset printString , ' should be an SmallInteger']. + ^self longAtValidOffset: offset +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +longAtOffset: offset put: integer + integer < 0 + ifTrue: [self uLongAtOffset: offset put: integer + 16r100000000] + ifFalse: [self uLongAtOffset: offset put: integer] +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +longAtValidOffset: offset + | lo hi sign | + lo := self uShortAtValidOffset: offset. + hi := self uShortAtValidOffset: offset + 2. + sign := hi bitAnd: 16r8000. + hi := hi - (sign * 2). + ^hi * 16r10000 + lo +! ! + +!ExternalMemory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +makeBytes + | bytes | + bytes := self bytes. + self free. + ^bytes +! ! + +!ExternalMemory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +makeFloat + ^Float fromByteArray: self makeBytes +! ! + +!ExternalMemory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +makeString + | string | + string := String fromMemory: self. + self free. + ^string +! ! + +!ExternalMemory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +makeULong + | ulong | + ulong := self uLongAtOffset: 0. + self free. + ^ulong +! ! + +!ExternalMemory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +makeUnicode + | unicode | + unicode := WideString fromMemory: self. + self free. + ^unicode +! ! + +!ExternalMemory methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:37'! +pointedMemory + ^self +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +uLargeAtOffset: offset + | low hi | + low := self uLongAtOffset: offset. + hi := self uLongAtOffset: offset + 4. + ^(hi bitShift: 32) + low +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +uLargeAtOffset: offset put: value + self uLongAtOffset: offset put: (value bitAnd: 16rFFFFFFFF). + self uLongAtOffset: offset + 4 put: (value bitShift: -32) +! ! + +!ExternalMemory methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +printOn: aStream + | hex | + aStream nextPutAll: self class name , '{'. + hex := self isValid + ifTrue: [self asInteger printPaddedWith: $0 to: 8 base: 16] + ifFalse: ['invalid']. + aStream nextPutAll: hex; nextPut: $} +! ! + +!ExternalMemory methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:37'! +readStream + | stream | + stream := InternalReadStream on: self. + ^stream readLimit: SmallInteger maximum +! ! + +!ExternalMemory methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:37'! +release + self releaseMemory; invalidate +! ! + +!ExternalMemory methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:37'! +releaseMemory + heap ifNotNil: [heap free: self] +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +replaceBytesUpTo: count with: aCollection + ^self replaceBytesFrom: 1 to: count with: aCollection startingAt: 1 +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +replaceFirst: count with: aCollection + ^self replaceFrom: 1 to: count with: aCollection startingAt: 1 +! ! + +!ExternalMemory methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:37'! +replaceFrom: start to: stop with: anObject startingAt: position + | pos | + pos := anObject isUnicodeString + ifTrue: [anObject indexAt: position] + ifFalse: [position]. + self + replaceBytesFrom: start + to: stop + with: anObject + startingAt: pos +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +segmentFrom: index size: size + ^ByteArraySegment on: self from: index size: size +! ! + +!ExternalMemory methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:37'! +sessionShutdown + self ignoreFinalization +! ! + +!ExternalMemory methodsFor: 'startup' stamp: 'KenD 28/Jun/2026 13:27:37'! +sessionStartup + self invalidate +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +shortAtValidOffset: offset + | lo hi sign | + lo := self atOffset: offset. + hi := self atOffset: offset + 1. + sign := hi bitAnd: 16r80. + hi := hi - (sign * 2). + ^hi * 16r100 + lo +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +size + ^address size +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +sizeInBytes + ^self class sizeInBytes +! ! + +!ExternalMemory methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:37'! +smallPointer + ^address smallPointerAtOffset: 0 +! ! + +!ExternalMemory methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:37'! +smallPointer: anInteger + ^address smallPointerAtOffset: 0 put: anInteger +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +smallPointerAtOffset: offset + | low high | + WordSize = 8 ifTrue: [^(self pointerAtOffset: offset) // 2]. + low := self uShortAtOffset: offset. + low := low bitShift: -1. + high := self uShortAtOffset: offset + 2. + high := high bitShift: 15. + ^high + low +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +smallPointerAtOffset: offset put: anInteger + | low high | + WordSize = 8 ifTrue: [^self pointerAtOffset: offset put: anInteger * 2]. + low := anInteger bitAnd: 0xFFFF. + low := low bitShift: 1. + low := low bitAnd: 0xFFFF. + self uShortAtOffset: offset put: low. + high := anInteger bitShift: -15. + self uShortAtOffset: offset + 2 put: high +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +uLargeAtOffset: offset + | low hi | + low := self uLongAtOffset: offset. + hi := self uLongAtOffset: offset + 4. + ^(hi bitShift: 32) + low +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +uLargeAtOffset: offset put: value + self uLongAtOffset: offset put: (value bitAnd: 16rFFFFFFFF). + self uLongAtOffset: offset + 4 put: (value bitShift: -32) +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +uLongAtOffset: offset + | ulong | + ulong := 0. + offset + 4 + to: offset + 1 + by: -1 + do: [:i | ulong := (ulong bitShift: 8) + (self byteAt: i)]. + ^ulong +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +uLongAtOffset: offset put: anInteger + | low high | + low := anInteger isInteger + ifTrue: [anInteger bitAnd: 0xFFFF] + ifFalse: [anInteger lowPart]. + high := anInteger isInteger + ifTrue: [anInteger bitShift: -16] + ifFalse: [anInteger highPart]. + self + byteAt: offset + 1 put: (low bitAnd: 16rFF); + byteAt: offset + 2 put: (low bitShift: -8); + byteAt: offset + 3 put: (high bitAnd: 16rFF); + byteAt: offset + 4 put: ((high bitShift: -8) bitAnd: 16rFF) +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +uShortAtOffset: offset + ^(self atOffset: offset) + ((self atOffset: offset + 1) bitShift: 8) +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +uShortAtOffset: offset put: integer + self + atOffset: offset put: (integer bitAnd: 16rFF); + atOffset: offset + 1 put: ((integer bitShift: -8) bitAnd: 16rFF) +! ! + +!ExternalMemory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +uShortAtValidOffset: offset + ^(self atOffset: offset + 1) * 16r100 + (self atOffset: offset) +! ! + +!ExternalMemory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeStream + | writer | + writer := InternalWriteStream on: self. + writer writeLimit: self length. + ^writer +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExternalMemory class' category: #FFI! +ExternalMemory class + instanceVariableNames: ''! + +!ExternalMemory class methodsFor: 'inspecting' stamp: 'KenD 28/Jun/2026 13:27:37'! +allocate: anInteger + ^FFI defaultHeap allocate: anInteger +! ! + +!ExternalMemory class methodsFor: 'inspecting' stamp: 'KenD 28/Jun/2026 13:27:37'! +aspects + ^#(#asInteger) +! ! + +!ExternalMemory class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +at: anInteger + ^self new address: anInteger +! ! + +!ExternalMemory class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +at: anInteger heap: anExternalHeap + ^self new address: anInteger; heap: anExternalHeap +! ! + +!ExternalMemory class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +fromByteArray: aByteArray + | count memory | + count := aByteArray sizeInBytes. + memory := self allocate: count. + ^memory replaceBytesUpTo: count with: aByteArray +! ! + +!ExternalMemory class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +fromString: aString + | bytes extra memory | + bytes := aString sizeInBytes. + extra := aString characterSize. + memory := self allocate: bytes + extra. + memory replaceBytesUpTo: bytes with: aString. + ^memory +! ! + +!ExternalMemory class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasFixedSize + ^self hasVariableSize not +! ! + +!ExternalMemory class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasVariableSize + ^false +! ! + +!ExternalMemory class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initializeConstants + self addNamespace + at: #NullAddress put: (ByteArray new: WordSize); + yourself. +! ! + +!ExternalMemory class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +sizeInBytes + ^WordSize +! ! + + +ExternalMemory initialize! + diff --git a/modules/FFI/ExternalObject.Class.st b/modules/FFI/ExternalObject.Class.st new file mode 100644 index 00000000..7e1e42da --- /dev/null +++ b/modules/FFI/ExternalObject.Class.st @@ -0,0 +1,52 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ExternalObject category: #FFI! +Object subclass: #ExternalObject + instanceVariableNames: 'handle' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!ExternalObject commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!ExternalObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +asParameter + ^handle +! ! + +!ExternalObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +handle + ^handle +! ! + +!ExternalObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +handle: anObject + handle := anObject +! ! + +!ExternalObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isValid + ^handle notNil +! ! + +!ExternalObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + self requireFinalization +! ! + +!ExternalObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +release +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExternalObject class' category: #FFI! +ExternalObject class + instanceVariableNames: ''! + + +ExternalObject initialize! + diff --git a/modules/FFI/FFIDescriptor.Class.st b/modules/FFI/FFIDescriptor.Class.st new file mode 100644 index 00000000..f749ea29 --- /dev/null +++ b/modules/FFI/FFIDescriptor.Class.st @@ -0,0 +1,66 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #FFIDescriptor category: #FFI! +ArrayedCollection subclass: #FFIDescriptor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!FFIDescriptor commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!FFIDescriptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +argumentCount + ^self size - 2 +! ! + +!FFIDescriptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +argumentTypeAt: index + ^self at: index +! ! + +!FFIDescriptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +argumentTypeAt: index put: typeInteger + self at: index put: typeInteger +! ! + +!FFIDescriptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +argumentTypes + ^(1 to: self argumentCount) collect: [:i | self argumentTypeAt: i] +! ! + +!FFIDescriptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +argumentTypes: types + types withIndexDo: [:code :i | self argumentTypeAt: i put: code] +! ! + +!FFIDescriptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +callingConvention + ^self at: self size +! ! + +!FFIDescriptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +callingConvention: ccCode + self at: self size put: ccCode +! ! + +!FFIDescriptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +returnType + ^self at: self size - 1 +! ! + +!FFIDescriptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +returnType: anInteger + self at: self size - 1 put: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FFIDescriptor class' category: #FFI! +FFIDescriptor class + instanceVariableNames: ''! + + diff --git a/modules/FFI/FFIMethod.Class.st b/modules/FFI/FFIMethod.Class.st new file mode 100644 index 00000000..263bf311 --- /dev/null +++ b/modules/FFI/FFIMethod.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #FFIMethod category: #FFI! +CompiledMethod subclass: #FFIMethod + instanceVariableNames: 'descriptor symbol address' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!FFIMethod commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!FFIMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +address + ^address +! ! + +!FFIMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +address: anInteger + address := anInteger +! ! + +!FFIMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +descriptor + ^descriptor +! ! + +!FFIMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +descriptor: anFFIDescriptor + descriptor := anFFIDescriptor +! ! + +!FFIMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +descriptorBytes: aByteArray + descriptor := FFIDescriptor withAll: aByteArray +! ! + +!FFIMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +symbol + ^symbol +! ! + +!FFIMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +symbol: aString + symbol := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FFIMethod class' category: #FFI! +FFIMethod class + instanceVariableNames: ''! + + diff --git a/modules/FFI/FFIModule.Class.st b/modules/FFI/FFIModule.Class.st new file mode 100644 index 00000000..adcb0946 --- /dev/null +++ b/modules/FFI/FFIModule.Class.st @@ -0,0 +1,100 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #FFIModule category: #FFI! +Module subclass: #FFIModule + instanceVariableNames: 'loader mallocHeap defaultHeap libc' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!FFIModule commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!FFIModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +defaultHeap + ^defaultHeap +! ! + +!FFIModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(ArrayedCollection Behavior ByteArray ByteArraySegment CharacterArray Float Integer IdentitySet String WordSize) + } +! ! + +!FFIModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +initializeFor: moduleName loader: loaderName + | module loaderType | + module := Kernel load: moduleName. + self namespace + at: #FFI put: self; + at: #OS put: module. + loaderType := module namespace at: loaderName. + loader := loaderType new +! ! + +!FFIModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +initializeLibC + libc := LibC new. + loader bootstrapOpen: libc. + defaultHeap := mallocHeap := MallocHeap new +! ! + +!FFIModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initializeForCurrentPlatform + | platform | + platform := Kernel host platformName. + (platform endsWith: 'linux-gnu') ifTrue: [^self initializeForLinux]. + (platform endsWith: 'darwin') ifTrue: [^self initializeForMac]. + (platform endsWith: 'win32') ifTrue: [^self initializeForWindows]. + self error: platform, ' platform not yet supported by FFI module' +! ! + +!FFIModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initializeForLinux + self + initializeFor: #'FFI.Posix' loader: #PosixLibraryLoader; + initializeLibC +! ! + +!FFIModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initializeForMac + self initializeFor: #'FFI.Posix' loader: #PosixLibraryLoader. + loader beMac. + self initializeLibC. +! ! + +!FFIModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initializeForWindows + self + initializeFor: #'FFI.Windows' loader: #WindowsLibraryLoader; + initializeLibC. +! ! + +!FFIModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + super initialize. + ExternalMemory initializeConstants. +! ! + +!FFIModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +libc + ^libc +! ! + +!FFIModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +loader + ^loader +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FFIModule class' category: #FFI! +FFIModule class + instanceVariableNames: ''! + + +FFIModule initialize! + diff --git a/modules/FFI/Float.Extension.st b/modules/FFI/Float.Extension.st new file mode 100644 index 00000000..88f8c160 --- /dev/null +++ b/modules/FFI/Float.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!Float methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:37'! +externalCopy + ^ExternalMemory fromByteArray: self +! ! + + diff --git a/modules/FFI/Integer.Extension.st b/modules/FFI/Integer.Extension.st new file mode 100644 index 00000000..54b59bf2 --- /dev/null +++ b/modules/FFI/Integer.Extension.st @@ -0,0 +1,19 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!Integer methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +externalBytes + ^ExternalMemory allocate: self +! ! + +!Integer methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +externalCharacters + ^ExternalMemory allocate: self + 1 * 2 +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:37'! +pointedMemory + ^ExternalMemory at: self +! ! + + diff --git a/modules/FFI/LibC.Class.st b/modules/FFI/LibC.Class.st new file mode 100644 index 00000000..b1d9026a --- /dev/null +++ b/modules/FFI/LibC.Class.st @@ -0,0 +1,46 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #LibC category: #FFI! +ExternalLibrary subclass: #LibC + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!LibC commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!LibC methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +calloc: anInteger size: size + +! ! + +!LibC methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +free: address + +! ! + +!LibC methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +malloc: anInteger + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LibC class' category: #FFI! +LibC class + instanceVariableNames: ''! + +!LibC class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +libname + ^'c' +! ! + +!LibC class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +linuxFilename + ^'libc.so.6' +! ! + + diff --git a/modules/FFI/LibraryLoader.Class.st b/modules/FFI/LibraryLoader.Class.st new file mode 100644 index 00000000..92406c6c --- /dev/null +++ b/modules/FFI/LibraryLoader.Class.st @@ -0,0 +1,34 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #LibraryLoader category: #FFI! +Object subclass: #LibraryLoader + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!LibraryLoader commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. + + I'm an object that allows loading dynamic libraries. My subclasses know + how to do it in each platform. +! + +!LibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +open: anExternalLibrary + self subclassResponsibility +! ! + +!LibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +findSymbol: aSymbol in: anExternalLibrary + ^self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LibraryLoader class' category: #FFI! +LibraryLoader class + instanceVariableNames: ''! + + diff --git a/modules/FFI/MallocHeap.Class.st b/modules/FFI/MallocHeap.Class.st new file mode 100644 index 00000000..0d346031 --- /dev/null +++ b/modules/FFI/MallocHeap.Class.st @@ -0,0 +1,42 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #MallocHeap category: #FFI! +Object subclass: #MallocHeap + instanceVariableNames: 'libc' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!MallocHeap commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. + + I'm an object that represents a dynamic library such as an so, a dll or a dylib +! + +!MallocHeap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +allocate: anInteger + | address | + address := libc calloc: anInteger size: 1. + ^ExternalMemory at: address heap: self. +! ! + +!MallocHeap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +free: anExternalMemory + libc free: anExternalMemory asParameter. +! ! + +!MallocHeap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + libc := FFI libc +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MallocHeap class' category: #FFI! +MallocHeap class + instanceVariableNames: ''! + + +MallocHeap initialize! + diff --git a/modules/FFI/Object.Extension.st b/modules/FFI/Object.Extension.st new file mode 100644 index 00000000..b6506ef0 --- /dev/null +++ b/modules/FFI/Object.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isExternalMemory + ^false +! ! + + diff --git a/modules/FFI/Posix/DLLibrary.Class.st b/modules/FFI/Posix/DLLibrary.Class.st new file mode 100644 index 00000000..60bd51b8 --- /dev/null +++ b/modules/FFI/Posix/DLLibrary.Class.st @@ -0,0 +1,47 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #DLLibrary category: #FFI! +ExternalLibrary subclass: #DLLibrary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!DLLibrary commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. + + I represent dl, the library used in linux to dynamically load other libraries. +! + +!DLLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +dlerror + +! ! + +!DLLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +dlopen: filename flags: flags + +! ! + +!DLLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +dlsym: handle symbol: functionName + +! ! + +!DLLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +lastError + | address cstring | + address := self dlerror. + address = 0 ifTrue: [self error: 'no error message when a dlerror was expected']. + cstring := ExternalMemory at: address. + String fromMemory: cstring +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'DLLibrary class' category: #FFI! +DLLibrary class + instanceVariableNames: ''! + + diff --git a/modules/FFI/Posix/PosixLibraryLoader.Class.st b/modules/FFI/Posix/PosixLibraryLoader.Class.st new file mode 100644 index 00000000..3896d6a1 --- /dev/null +++ b/modules/FFI/Posix/PosixLibraryLoader.Class.st @@ -0,0 +1,90 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #PosixLibraryLoader category: #FFI! +LibraryLoader subclass: #PosixLibraryLoader + instanceVariableNames: 'dl linux' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!PosixLibraryLoader commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. + + I'm an object that allows loading dynamic libraries in Linux and Mac. For that, + I call dlopen and dlsym, part of dl library. To bootstrap, the dl library + object handle and dlsym addresses are initialized through a host VM primitive. +! + +!PosixLibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +beMac + linux := false +! ! + +!PosixLibraryLoader methodsFor: 'bootstrap' stamp: 'KenD 28/Jun/2026 13:27:37'! +bootstrapOpen: anExternalLibrary + " + We do this because externalCopy asParameter requires libc/calloc to be already loaded + " + | filename path parameter handle | + filename := self libraryFilename: anExternalLibrary class. + path := anExternalLibrary class libpath, filename. + parameter := Array with: path. + handle := filename = 'libc.dylib' + ifTrue: [dl handle asInteger] + ifFalse: [dl dlopen: parameter flags: 1. "RTLD_LAZY"]. + handle = 0 ifTrue: [dl lastError]. + anExternalLibrary address: handle. +! ! + +!PosixLibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +close: anExternalLibrary + dl dlclose: anExternalLibrary asParameter +! ! + +!PosixLibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +findSymbol: aSymbol in: anExternalLibrary + ^dl dlsym: anExternalLibrary asParameter symbol: aSymbol externalCopy asParameter +! ! + +!PosixLibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + linux := true. + dl := DLLibrary new. + Kernel host initializeFFI: dl symbolFinder: DLLibrary >> #dlsym:symbol:. + self initializeDLErrorDescriptor +! ! + +!PosixLibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +initializeDLErrorDescriptor + " + Sending dlerror for the first time initializes libdl descriptor, through dlsym. This makes + subsequent sends of dlerror not call dlsym, which would invalidate the last error code + " + dl dlerror +! ! + +!PosixLibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +libraryFilename: externalLibrary + ^linux ifTrue: [ externalLibrary linuxFilename ] ifFalse: [ externalLibrary macFilename ] +! ! + +!PosixLibraryLoader methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +open: anExternalLibrary + | filename path handle | + filename := self libraryFilename: anExternalLibrary class. + path := anExternalLibrary class libpath, filename. + handle := dl dlopen: path externalCopy asParameter flags: 1. "RTLD_LAZY" + handle = 0 ifTrue: [Error signal: dl lastError]. + anExternalLibrary address: handle +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PosixLibraryLoader class' category: #FFI! +PosixLibraryLoader class + instanceVariableNames: ''! + + +PosixLibraryLoader initialize! + diff --git a/modules/FFI/Posix/PosixModule.Class.st b/modules/FFI/Posix/PosixModule.Class.st new file mode 100644 index 00000000..ac163116 --- /dev/null +++ b/modules/FFI/Posix/PosixModule.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #PosixModule category: #FFI! +Module subclass: #PosixModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!PosixModule commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!PosixModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +externalCopyOfString: aString + ^Kernel utf8 externalCopyOf: aString +! ! + +!PosixModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ #FFI -> #(ExternalLibrary ExternalMemory LibraryLoader) } +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PosixModule class' category: #FFI! +PosixModule class + instanceVariableNames: ''! + + diff --git a/modules/FFI/String.Extension.st b/modules/FFI/String.Extension.st new file mode 100644 index 00000000..b7c735e1 --- /dev/null +++ b/modules/FFI/String.Extension.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +fromMemory: anExternalMemory + | length | + length := 1. + [(anExternalMemory at: length) = 0] whileFalse: [length := length + 1]. + ^self fromMemory: anExternalMemory length: length - 1 +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +fromMemory: anExternalMemory length: anInteger + | string | + string := self new: anInteger. + string replaceFrom: 1 to: anInteger with: anExternalMemory startingAt: 1. + ^string +! ! + + diff --git a/modules/FFI/Tests/TestLibrary.Class.st b/modules/FFI/Tests/TestLibrary.Class.st new file mode 100644 index 00000000..7ac57191 --- /dev/null +++ b/modules/FFI/Tests/TestLibrary.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestLibrary category: #Tests! +ExternalLibrary subclass: #TestLibrary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tests'! +!TestLibrary commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!TestLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addInt: anInteger toInt: anotherInteger + +! ! + +!TestLibrary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addDouble: aDouble toDouble: anotherDouble + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestLibrary class' category: #Tests! +TestLibrary class + instanceVariableNames: ''! + +!TestLibrary class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +libname + ^'test' +! ! + +!TestLibrary class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +libpath + ^'./' +! ! + + diff --git a/modules/FFI/Tests/TestsModule.Class.st b/modules/FFI/Tests/TestsModule.Class.st new file mode 100644 index 00000000..027e1e78 --- /dev/null +++ b/modules/FFI/Tests/TestsModule.Class.st @@ -0,0 +1,42 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestsModule category: #Tests! +Module subclass: #TestsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tests'! +!TestsModule commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!TestsModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(WordSize). + #FFI -> #(ExternalLibrary) + } +! ! + +!TestsModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +main: args + | test result | + ExternalLibrary module initializeForCurrentPlatform. + + test := TestLibrary new open. + result := test addInt: 3 toInt: 4. + result = 7 ifFalse: [self error: 'addInt:toInt: failed!!']. + result := test addDouble: 3.0 toDouble: 4.0. + result = 7.0 ifFalse: [self error: 'addDouble:toDouble: failed!!']. + Kernel log: 'all FFI tests passed!!' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestsModule class' category: #Tests! +TestsModule class + instanceVariableNames: ''! + + diff --git a/modules/FFI/Windows/KernelDLL.Class.st b/modules/FFI/Windows/KernelDLL.Class.st new file mode 100644 index 00000000..eaed412d --- /dev/null +++ b/modules/FFI/Windows/KernelDLL.Class.st @@ -0,0 +1,38 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #KernelDLL category: #FFI! +ExternalLibrary subclass: #KernelDLL + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!KernelDLL commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. + + I represent Kernel DLL, the main library used in Windows applications. +! + +!KernelDLL methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +LoadLibraryW: lpLibFileName + +! ! + +!KernelDLL methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +GetProcAddress: hModule lpProcName: lpProcName + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'KernelDLL class' category: #FFI! +KernelDLL class + instanceVariableNames: ''! + +!KernelDLL class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name + ^'kernel32' +! ! + + diff --git a/modules/FFI/Windows/WindowsLibraryLoader.Class.st b/modules/FFI/Windows/WindowsLibraryLoader.Class.st new file mode 100644 index 00000000..22b46435 --- /dev/null +++ b/modules/FFI/Windows/WindowsLibraryLoader.Class.st @@ -0,0 +1,60 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #WindowsLibraryLoader category: #FFI! +LibraryLoader subclass: #WindowsLibraryLoader + instanceVariableNames: 'kernel32' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!WindowsLibraryLoader commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. + + I'm an object that allows loading dynamic libraries in Windows. For that, + I call LoadLibrary and GetProcAddress, part of kernel32 library. That + library object is initialized when the windows process is launched. +! + +!WindowsLibraryLoader methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +bootstrapOpen: anExternalLibrary + | path parameter handle | + path := anExternalLibrary class libpath, anExternalLibrary class windowsFilename. + parameter := Array with: path. + handle := kernel32 LoadLibraryW: parameter. + anExternalLibrary handle: handle. +! ! + +!WindowsLibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +findSymbol: aSymbol in: anExternalLibrary + ^kernel32 GetProcAddressW: anExternalLibrary asParameter lpProcName: aSymbol externalCopy asParameter. +! ! + +!WindowsLibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + kernel32 := KernelDLL new. + Kernel host initializeFFI: kernel32 symbolFinder: KernelDLL >> #GetProcAddressW +! ! + +!WindowsLibraryLoader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +libraryFilename: externalLibrary + ^externalLibrary windowsFilename. +! ! + +!WindowsLibraryLoader methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +open: anExternalLibrary + | path handle | + path := anExternalLibrary class libpath, anExternalLibrary class windowsFilename. + handle := kernel32 LoadLibraryW: path externalCopy asParameter. + anExternalLibrary address: handle. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WindowsLibraryLoader class' category: #FFI! +WindowsLibraryLoader class + instanceVariableNames: ''! + + +WindowsLibraryLoader initialize! + diff --git a/modules/FFI/Windows/WindowsModule.Class.st b/modules/FFI/Windows/WindowsModule.Class.st new file mode 100644 index 00000000..82545152 --- /dev/null +++ b/modules/FFI/Windows/WindowsModule.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #WindowsModule category: #FFI! +Module subclass: #WindowsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI'! +!WindowsModule commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!WindowsModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +externalCopyOfString: aString + ^Kernel utf16 externalCopyOf: aString +! ! + +!WindowsModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ #FFI -> #(ExternalLibrary LibraryLoader) } +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WindowsModule class' category: #FFI! +WindowsModule class + instanceVariableNames: ''! + + diff --git a/modules/Filesystem/Directory.Class.st b/modules/Filesystem/Directory.Class.st new file mode 100644 index 00000000..5f61c2ad --- /dev/null +++ b/modules/Filesystem/Directory.Class.st @@ -0,0 +1,38 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #Directory category: #Filesystem! +FilesystemEntry subclass: #Directory + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Filesystem'! +!Directory commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!Directory methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +/ aString + | handle | + handle := Library pathOperatorSlash: self path with: aString. + ^Directory new handle: handle +! ! + +!Directory methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPath + ^Library directoryPath: self +! ! + +!Directory methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +create + Library pathCreateDirectory: self path +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Directory class' category: #Filesystem! +Directory class + instanceVariableNames: ''! + + diff --git a/modules/Filesystem/File.Class.st b/modules/Filesystem/File.Class.st new file mode 100644 index 00000000..bc8a6dba --- /dev/null +++ b/modules/Filesystem/File.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #File category: #Filesystem! +FilesystemEntry subclass: #File + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Filesystem'! +!File commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!File methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +/ aString + self error: 'invalid operation' +! ! + +!File methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPath + self error +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'File class' category: #Filesystem! +File class + instanceVariableNames: ''! + + diff --git a/modules/Filesystem/FilesystemEntry.Class.st b/modules/Filesystem/FilesystemEntry.Class.st new file mode 100644 index 00000000..3a884af9 --- /dev/null +++ b/modules/Filesystem/FilesystemEntry.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #FilesystemEntry category: #Filesystem! +ExternalObject subclass: #FilesystemEntry + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Filesystem'! +!FilesystemEntry commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!FilesystemEntry methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPath + ^self subclassResponsibility +! ! + +!FilesystemEntry methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +directory + ^self parent asDirectory +! ! + +!File methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +exists + ^self path exists +! ! + +!FilesystemEntry methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +path + ^Path new handle: self basicPath +! ! + +!FilesystemEntry methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parent + ^Path new handle: (Library pathParent: self) +! ! + +!FilesystemEntry methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +remove + ^self path remove +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FilesystemEntry class' category: #Filesystem! +FilesystemEntry class + instanceVariableNames: ''! + +!FilesystemEntry class methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: aString + ^self new handle: (Library pathNew: aString) +! ! + + diff --git a/modules/Filesystem/FilesystemModule.Class.st b/modules/Filesystem/FilesystemModule.Class.st new file mode 100644 index 00000000..2f9f022e --- /dev/null +++ b/modules/Filesystem/FilesystemModule.Class.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #FilesystemModule category: #Filesystem! +Module subclass: #FilesystemModule + instanceVariableNames: 'library' + classVariableNames: '' + poolDictionaries: '' + category: 'Filesystem'! +!FilesystemModule commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!FilesystemModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #FFI -> ExternalObject + } +! ! + +!FilesystemModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeWith: library + namespace at: #Library put: library. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FilesystemModule class' category: #Filesystem! +FilesystemModule class + instanceVariableNames: ''! + + diff --git a/modules/Filesystem/Native/CPPFilesystemLibrary.Class.st b/modules/Filesystem/Native/CPPFilesystemLibrary.Class.st new file mode 100644 index 00000000..7ecbf59b --- /dev/null +++ b/modules/Filesystem/Native/CPPFilesystemLibrary.Class.st @@ -0,0 +1,81 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #CPPFilesystemLibrary category: #Filesystem! +ExternalLibrary subclass: #CPPFilesystemLibrary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Filesystem'! +!CPPFilesystemLibrary commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!CPPFilesystemLibrary methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +libname + ^'filesystem' +! ! + +!CPPFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +directoryFromPath: aPath + +! ! + +!CPPFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +directoryPath: aDirectory + +! ! + +!CPPFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +directoryRelease: aDirectory + +! ! + +!CPPFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathCreateDirectory: aPath + +! ! + +!CPPFilesystemLibrary methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathExists: aPath + +! ! + +!CPPFilesystemLibrary methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathFilename: string + +! ! + +!CPPFilesystemLibrary methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathNew: string + +! ! + +!CPPFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathParent: aPath + +! ! + +!CPPFilesystemLibrary methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathOperatorSlash: aPath with: string + +! ! + +!CPPFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathRemove: aPath + +! ! + +!CPPFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathRelease: aPath + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CPPFilesystemLibrary class' category: #Filesystem! +CPPFilesystemLibrary class + instanceVariableNames: ''! + + diff --git a/modules/Filesystem/Native/NativeFSModule.Class.st b/modules/Filesystem/Native/NativeFSModule.Class.st new file mode 100644 index 00000000..3855ad01 --- /dev/null +++ b/modules/Filesystem/Native/NativeFSModule.Class.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #NativeFSModule category: #NativeFSModule! +Module subclass: #NativeFSModule + instanceVariableNames: 'library' + classVariableNames: '' + poolDictionaries: '' + category: 'NativeFSModule'! +!NativeFSModule commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!NativeFSModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #FFI -> ExternalLibrary + } +! ! + +!NativeFSModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +newLibrary + ^CPPFilesystemLibrary new open +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NativeFSModule class' category: #NativeFSModule! +NativeFSModule class + instanceVariableNames: ''! + + diff --git a/modules/Filesystem/Node/NodeFSModule.Class.st b/modules/Filesystem/Node/NodeFSModule.Class.st new file mode 100644 index 00000000..0c5319d6 --- /dev/null +++ b/modules/Filesystem/Node/NodeFSModule.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #NodeFSModule category: #NodeFSModule! +Module subclass: #NodeFSModule + instanceVariableNames: 'library' + classVariableNames: '' + poolDictionaries: '' + category: 'NodeFSModule'! +!NodeFSModule commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!NodeFSModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{} +! ! + +!NodeFSModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +newLibrary + ^NodeFilesystemLibrary new +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NodeFSModule class' category: #NodeFSModule! +NodeFSModule class + instanceVariableNames: ''! + + diff --git a/modules/Filesystem/Node/NodeFilesystemLibrary.Class.st b/modules/Filesystem/Node/NodeFilesystemLibrary.Class.st new file mode 100644 index 00000000..da8c4e5f --- /dev/null +++ b/modules/Filesystem/Node/NodeFilesystemLibrary.Class.st @@ -0,0 +1,81 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #NodeFilesystemLibrary category: #Filesystem! +Object subclass: #NodeFilesystemLibrary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Filesystem'! +!NodeFilesystemLibrary commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!NodeFilesystemLibrary methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +libname + ^'filesystem' +! ! + +!NodeFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +directoryFromPath: aPath + +! ! + +!NodeFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +directoryPath: aDirectory + +! ! + +!NodeFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +directoryRelease: aDirectory + +! ! + +!NodeFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathCreateDirectory: aPath + +! ! + +!NodeFilesystemLibrary methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathExists: aPath + +! ! + +!NodeFilesystemLibrary methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathFilename: string + +! ! + +!NodeFilesystemLibrary methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathNew: string + +! ! + +!NodeFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathParent: aPath + +! ! + +!NodeFilesystemLibrary methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathOperatorSlash: aPath with: string + +! ! + +!NodeFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathRemove: aPath + +! ! + +!NodeFilesystemLibrary methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pathRelease: aPath + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NodeFilesystemLibrary class' category: #Filesystem! +NodeFilesystemLibrary class + instanceVariableNames: ''! + + diff --git a/modules/Filesystem/Path.Class.st b/modules/Filesystem/Path.Class.st new file mode 100644 index 00000000..6812e0d0 --- /dev/null +++ b/modules/Filesystem/Path.Class.st @@ -0,0 +1,64 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #Path category: #Filesystem! +ExternalObject subclass: #Path + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Filesystem'! +!Path commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!Path methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +/ aString + ^Path new handle: (Library pathOperatorSlash: self with: aString) +! ! + +!Path methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +asDirectory + | handle | + handle := Library directoryFromPath: self. + handle = 0 ifTrue: [^self error: 'operation failed']. + ^Directory new handle: handle +! ! + +!Path methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +createDirectory + ^Library pathCreateDirectory: self +! ! + +!Path methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +exists + ^Library pathExists: self +! ! + +!Path methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^Library pathFilename: self +! ! + +!Path methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +remove + ^Library pathRemove: self +! ! + +!Path methodsFor: 'releasing' stamp: 'KenD 28/Jun/2026 13:27:39'! +remove + ^Library pathRelease: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Path class' category: #Filesystem! +Path class + instanceVariableNames: ''! + +!Path class methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: aString + ^self handle: (Library newPath: aString) +! ! + + diff --git a/modules/Filesystem/String.Extension.st b/modules/Filesystem/String.Extension.st new file mode 100644 index 00000000..b81f8e63 --- /dev/null +++ b/modules/Filesystem/String.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +asFilename + ^Library pathNew: self +! ! + + diff --git a/modules/HTTP/CPPHTTPServer/CPPHTTPServerModule.Class.st b/modules/HTTP/CPPHTTPServer/CPPHTTPServerModule.Class.st new file mode 100644 index 00000000..a575c978 --- /dev/null +++ b/modules/HTTP/CPPHTTPServer/CPPHTTPServerModule.Class.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #CPPHTTPServerModule category: #CPPHTTPServer! +Module subclass: #CPPHTTPServerModule + instanceVariableNames: 'library' + classVariableNames: '' + poolDictionaries: '' + category: 'CPPHTTPServer'! +!CPPHTTPServerModule commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!CPPHTTPServerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +imports + ^{ + #FFI -> #(ExternalLibrary ExternalObject). + } +! ! + +!CPPHTTPServerModule methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +library + ^library ifNil: [library := HTTPServerLibrary new open] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CPPHTTPServerModule class' category: #CPPHTTPServer! +CPPHTTPServerModule class + instanceVariableNames: ''! + + diff --git a/modules/HTTP/CPPHTTPServer/HTTPMessage.Class.st b/modules/HTTP/CPPHTTPServer/HTTPMessage.Class.st new file mode 100644 index 00000000..d71464be --- /dev/null +++ b/modules/HTTP/CPPHTTPServer/HTTPMessage.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #HTTPMessage category: #CPPHTTPServer! +HTTPObject subclass: #HTTPMessage + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CPPHTTPServer'! +!HTTPMessage commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!HTTPMessage methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +accept + ^self headersAt: 'Accept' +! ! + +!HTTPMessage methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +headersAt: aString + ^self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HTTPMessage class' category: #CPPHTTPServer! +HTTPMessage class + instanceVariableNames: ''! + + diff --git a/modules/HTTP/CPPHTTPServer/HTTPObject.Class.st b/modules/HTTP/CPPHTTPServer/HTTPObject.Class.st new file mode 100644 index 00000000..ee45bd4f --- /dev/null +++ b/modules/HTTP/CPPHTTPServer/HTTPObject.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #HTTPObject category: #CPPHTTPServer! +ExternalObject subclass: #HTTPObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CPPHTTPServer'! +!HTTPObject commentStamp: '' prior: 0! + + Copyright (c) 2025, Javier Pimás. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HTTPObject class' category: #CPPHTTPServer! +HTTPObject class + instanceVariableNames: ''! + + diff --git a/modules/HTTP/CPPHTTPServer/HTTPRequest.Class.st b/modules/HTTP/CPPHTTPServer/HTTPRequest.Class.st new file mode 100644 index 00000000..e355cbdd --- /dev/null +++ b/modules/HTTP/CPPHTTPServer/HTTPRequest.Class.st @@ -0,0 +1,69 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #HTTPRequest category: #CPPHTTPServer! +ExternalObject subclass: #HTTPRequest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CPPHTTPServer'! +!HTTPRequest commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!HTTPRequest methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +paramAt: aString + | addr | + addr := self class module library + request: handle asParameter + paramAt: aString externalCopy asParameter. + + addr = 0 ifTrue: [^nil]. + + "should do better and look at encoding" + ^String fromMemory: addr pointedMemory +! ! + +!HTTPRequest methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +headersAt: aString + | addr | + addr := self class module library + request: handle asParameter + headersAt: aString externalCopy asParameter. + + addr = 0 ifTrue: [^nil]. + + "should do better and look at encoding" + ^String fromMemory: addr pointedMemory +! ! + +!HTTPRequest methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +path + | addr | + addr := self class module library + requestPath: handle asParameter. + + ^String fromMemory: addr pointedMemory +! ! + +!HTTPRequest methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +queryAt: aString + | addr | + addr := self class module library + request: handle asParameter + queryAt: aString externalCopy asParameter. + + addr = 0 ifTrue: [^nil]. + + "should do better and look at encoding" + ^String fromMemory: addr pointedMemory +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HTTPRequest class' category: #CPPHTTPServer! +HTTPRequest class + instanceVariableNames: ''! + + diff --git a/modules/HTTP/CPPHTTPServer/HTTPResponse.Class.st b/modules/HTTP/CPPHTTPServer/HTTPResponse.Class.st new file mode 100644 index 00000000..e92e9aee --- /dev/null +++ b/modules/HTTP/CPPHTTPServer/HTTPResponse.Class.st @@ -0,0 +1,51 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #HTTPResponse category: #CPPHTTPServer! +ExternalObject subclass: #HTTPResponse + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CPPHTTPServer'! +!HTTPResponse commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!HTTPResponse methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +notFound + self + status: 404; + setContents: 'The server has not found anything matching the requested URI (Uniform Resource Identifier).' type: 'text/plain'. +! ! + +!HTTPResponse methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +setContents: aString type: anotherString + self class module library + response: handle asParameter + setContents: aString externalCopy asParameter + type: anotherString externalCopy asParameter +! ! + +!HTTPResponse methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +status: anInteger + self class module library + response: handle asParameter + status: anInteger asParameter +! ! + +!HTTPResponse methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +headersAt: aString put: anotherString + self class module library + response: handle asParameter + headersAt: aString externalCopy asParameter + put: anotherString externalCopy asParameter +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HTTPResponse class' category: #CPPHTTPServer! +HTTPResponse class + instanceVariableNames: ''! + + diff --git a/modules/HTTP/CPPHTTPServer/HTTPServer.Class.st b/modules/HTTP/CPPHTTPServer/HTTPServer.Class.st new file mode 100644 index 00000000..bb01e7cf --- /dev/null +++ b/modules/HTTP/CPPHTTPServer/HTTPServer.Class.st @@ -0,0 +1,60 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #HTTPServer category: #CPPHTTPServer! +ExternalObject subclass: #HTTPServer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CPPHTTPServer'! +!HTTPServer commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!HTTPServer methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +handle: requestHandle with: handler into: responseHandle + | request response | + request := HTTPRequest new handle: requestHandle. + response := HTTPResponse new handle: responseHandle. + handler evaluateWith: request with: response. + ^responseHandle +! ! + +!HTTPServer methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + self handle: self library newServer. +! ! + +!HTTPServer methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +library + ^self class module library +! ! + +!HTTPServer methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +routeGET: uri to: handler + self library + server: self asParameter + GET: uri externalCopy asParameter + callback: [ :request :response | self handle: request with: handler into: response ] asCallback +! ! + +!HTTPServer methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +start + self library startServer: self asParameter +! ! + +!HTTPServer methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:38'! +stop + self library stopServer: self asParameter +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HTTPServer class' category: #CPPHTTPServer! +HTTPServer class + instanceVariableNames: ''! + + +HTTPServer initialize! + diff --git a/modules/HTTP/CPPHTTPServer/HTTPServerLibrary.Class.st b/modules/HTTP/CPPHTTPServer/HTTPServerLibrary.Class.st new file mode 100644 index 00000000..a50413ed --- /dev/null +++ b/modules/HTTP/CPPHTTPServer/HTTPServerLibrary.Class.st @@ -0,0 +1,101 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #HTTPServerLibrary category: #CPPHTTPServer! +ExternalLibrary subclass: #HTTPServerLibrary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CPPHTTPServer'! +!HTTPServerLibrary commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!HTTPServerLibrary methodsFor: 'server' stamp: 'KenD 28/Jun/2026 13:27:38'! +deleteServer: aServer + +! ! + +!HTTPServerLibrary methodsFor: 'server' stamp: 'KenD 28/Jun/2026 13:27:38'! +newServer + +! ! + +!HTTPServerLibrary methodsFor: 'server' stamp: 'KenD 28/Jun/2026 13:27:38'! +server: aServer DELETE: url callback: aCallback + +! ! + +!HTTPServerLibrary methodsFor: 'server' stamp: 'KenD 28/Jun/2026 13:27:38'! +server: aServer GET: url callback: aCallback + +! ! + +!HTTPServerLibrary methodsFor: 'server' stamp: 'KenD 28/Jun/2026 13:27:38'! +server: aServer POST: url callback: aCallback + +! ! + +!HTTPServerLibrary methodsFor: 'server' stamp: 'KenD 28/Jun/2026 13:27:38'! +startServer: aServer + +! ! + +!HTTPServerLibrary methodsFor: 'server' stamp: 'KenD 28/Jun/2026 13:27:38'! +stopServer: aServer + +! ! + +!HTTPServerLibrary methodsFor: 'request' stamp: 'KenD 28/Jun/2026 13:27:38'! +request: aRequest headersAt: aString + +! ! + +!HTTPServerLibrary methodsFor: 'request' stamp: 'KenD 28/Jun/2026 13:27:38'! +request: aRequest paramAt: aString + +! ! + +!HTTPServerLibrary methodsFor: 'request' stamp: 'KenD 28/Jun/2026 13:27:38'! +request: aRequest queryAt: aString + +! ! + +!HTTPServerLibrary methodsFor: 'request' stamp: 'KenD 28/Jun/2026 13:27:38'! +requestPath: aRequest + +! ! + +!HTTPServerLibrary methodsFor: 'response' stamp: 'KenD 28/Jun/2026 13:27:38'! +response: aResponse headersAt: aString put: anotherString + +! ! + +!HTTPServerLibrary methodsFor: 'response' stamp: 'KenD 28/Jun/2026 13:27:38'! +response: aResponse setContents: aString type: anotherString + +! ! + +!HTTPServerLibrary methodsFor: 'response' stamp: 'KenD 28/Jun/2026 13:27:38'! +response: aResponse status: anInteger + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HTTPServerLibrary class' category: #CPPHTTPServer! +HTTPServerLibrary class + instanceVariableNames: ''! + +!HTTPServerLibrary class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +libname + ^'httpserver' +! ! + +!HTTPServerLibrary class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +libpath + ^'./' +! ! + + diff --git a/modules/ImageSegmentBuilder/Behavior.Extension.st b/modules/ImageSegmentBuilder/Behavior.Extension.st new file mode 100644 index 00000000..babc8045 --- /dev/null +++ b/modules/ImageSegmentBuilder/Behavior.Extension.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Behavior methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asSymbolicReference + self DENY: self isInstanceBehavior. + ^SymbolicReference forBehavior: self +! ! + +!Behavior methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeStoredIn: anObjectClosure + ^anObjectClosure scope includes: class +! ! + + diff --git a/modules/ImageSegmentBuilder/Boolean.Extension.st b/modules/ImageSegmentBuilder/Boolean.Extension.st new file mode 100644 index 00000000..ced43cc8 --- /dev/null +++ b/modules/ImageSegmentBuilder/Boolean.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Boolean methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeStoredIn: anObjectClosure + ^anObjectClosure module == Kernel +! ! + + diff --git a/modules/ImageSegmentBuilder/Builder.Class.st b/modules/ImageSegmentBuilder/Builder.Class.st new file mode 100644 index 00000000..ef0fc02c --- /dev/null +++ b/modules/ImageSegmentBuilder/Builder.Class.st @@ -0,0 +1,125 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #Builder category: #ImageSegmentBuilder! +Object subclass: #Builder + instanceVariableNames: 'module closure classes' + classVariableNames: '' + poolDictionaries: '' + category: 'ImageSegmentBuilder'! +!Builder methodsFor: 'degugging' stamp: 'KenD 28/Jun/2026 13:27:39'! +activateDebugMode + closure activateDebugMode +! ! + +!Builder methodsFor: 'closure' stamp: 'KenD 28/Jun/2026 13:27:39'! +addNilToken + closure analyze: closure nilToken from: HashTable nilToken +! ! + +!Builder methodsFor: 'closure' stamp: 'KenD 28/Jun/2026 13:27:39'! +importNilToken + closure addBoundary: closure nilToken as: SymbolicReference nilToken +! ! + +!Builder methodsFor: 'closure' stamp: 'KenD 28/Jun/2026 13:27:39'! +addBoundary: anObject as: aSymbolicReference + closure addBoundary: anObject as: aSymbolicReference +! ! + +!Builder methodsFor: 'closure' stamp: 'KenD 28/Jun/2026 13:27:39'! +build + | metaclasses | + classes := module classes. + classes do: [:c | self mapClass: c]. + module prepareForSnapshot: self. + metaclasses := classes collect: [:c | c class]. + closure scope: classes , metaclasses; traverse: module. +! ! + +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +closure + ^closure +! ! + +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +objects + ^closure objects +! ! + +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +mapping + ^closure mapping +! ! + +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^closure boundary +! ! + +!Builder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +mapClass: aClass + self + mapSubclassesOf: aClass; + mapMethodsOf: aClass; + mapMethodsOf: aClass class +! ! + +!Builder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +mapMethodsOf: aClass + | original saved | + original := aClass methodDictionary. + saved := original collect: [:method | module originalMethodFor: method]. + saved := saved select: [:method | method notNil]. + saved do: [:method | self mapMethod: method]. + closure map: original to: saved +! ! + +!Builder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +mapMethod: method + | copy | + copy := method copy. + closure map: method to: copy. + method hasBlocks ifFalse: [^self]. + method withIndexDo: [:b :i | | bcopy | + b isBlock ifTrue: [ + bcopy := copy at: i. + closure map: b to: bcopy]] +! ! + +!Builder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +mapSubclassesOf: aClass + | original saved | + original := aClass subclasses. + saved := original select: [:s | module classes includes: s]. + closure map: original to: saved +! ! + +!Builder methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + closure := ObjectClosure new builder: self +! ! + +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +map: anObject to: anotherObject + closure map: anObject to: anotherObject +! ! + +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +module + ^module +! ! + +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +module: aModule + module := aModule. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Builder class' category: #ImageSegmentBuilder! +Builder class + instanceVariableNames: ''! + + +Builder initialize! + diff --git a/modules/ImageSegmentBuilder/Character.Extension.st b/modules/ImageSegmentBuilder/Character.Extension.st new file mode 100644 index 00000000..93b39726 --- /dev/null +++ b/modules/ImageSegmentBuilder/Character.Extension.st @@ -0,0 +1,14 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Character methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asSymbolicReference + ^SymbolicReference forCharacter: self +! ! + +!Character methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeStoredIn: anObjectClosure + ^anObjectClosure module == Kernel +! ! + + diff --git a/modules/ImageSegmentBuilder/Class.Extension.st b/modules/ImageSegmentBuilder/Class.Extension.st new file mode 100644 index 00000000..2c7b9ba5 --- /dev/null +++ b/modules/ImageSegmentBuilder/Class.Extension.st @@ -0,0 +1,14 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Class methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asSymbolicReference + ^SymbolicReference forClass: self +! ! + +!Class methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeStoredIn: anObjectClosure + ^anObjectClosure scope includes: self +! ! + + diff --git a/modules/ImageSegmentBuilder/False.Extension.st b/modules/ImageSegmentBuilder/False.Extension.st new file mode 100644 index 00000000..0c18aec7 --- /dev/null +++ b/modules/ImageSegmentBuilder/False.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!False methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asSymbolicReference + ^SymbolicReference new linker: #false +! ! + + diff --git a/modules/ImageSegmentBuilder/ImageSegmentBuilderModule.Class.st b/modules/ImageSegmentBuilder/ImageSegmentBuilderModule.Class.st new file mode 100644 index 00000000..f98c026c --- /dev/null +++ b/modules/ImageSegmentBuilder/ImageSegmentBuilderModule.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ImageSegmentBuilderModule category: #ImageSegmentBuilder! +Module subclass: #ImageSegmentBuilderModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ImageSegmentBuilder'! +!ImageSegmentBuilderModule commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!ImageSegmentBuilderModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #Kernel -> { + #Behavior. #Boolean. #False. #HashTable. #IdentityDictionary. #IdentitySet. #KernelModule. + #Module. #Symbol. #SymbolicReference. #True. #UndefinedObject + } + } +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ImageSegmentBuilderModule class' category: #ImageSegmentBuilder! +ImageSegmentBuilderModule class + instanceVariableNames: ''! + + diff --git a/modules/ImageSegmentBuilder/JSON/JSONModule.Class.st b/modules/ImageSegmentBuilder/JSON/JSONModule.Class.st new file mode 100644 index 00000000..8e992270 --- /dev/null +++ b/modules/ImageSegmentBuilder/JSON/JSONModule.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #JSONModule category: #'Powerlang-Core-Modules-JSON'! +Module subclass: #JSONModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Modules-JSON'! +!JSONModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #Kernel -> #(Module HashTable IdentityDictionary). + #ImageSegmentBuilder -> #Writer + } +! ! + +!JSONModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + self name: #'ImageSegmentBuilder.JSON' +! ! + +!JSONModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +newWriter + ^JSONWriter new +! ! + +!JSONModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +fileExtension + ^'json' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JSONModule class' category: #'Powerlang-Core-Modules-JSON'! +JSONModule class + instanceVariableNames: ''! + + +JSONModule initialize! + diff --git a/modules/ImageSegmentBuilder/JSON/JSONWriter.Class.st b/modules/ImageSegmentBuilder/JSON/JSONWriter.Class.st new file mode 100644 index 00000000..79119fe3 --- /dev/null +++ b/modules/ImageSegmentBuilder/JSON/JSONWriter.Class.st @@ -0,0 +1,159 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #JSONWriter category: #JSONWriter! +Writer subclass: #JSONWriter + instanceVariableNames: 'indexes' + classVariableNames: '' + poolDictionaries: '' + category: 'JSONWriter'! +!JSONWriter commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!JSONWriter methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + indexes := IdentityDictionary new. +! ! + +!JSONWriter methodsFor: 'closure' stamp: 'KenD 28/Jun/2026 13:27:39'! +generateIndexes + | index | + index := 0. + objects do: [:o | indexes at: o put: index. index := index + 1]. + imports keysDo: [:o | indexes at: o put: index. index := index + 1]. + mapping keysAndValuesDo: [:obj :surrogate | + indexes at: surrogate ifPresent: [:i | indexes at: obj put: i]]. +! ! + +!JSONWriter methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +indexOf: anObject + | path | + HashTable nilToken == anObject ifTrue: [^indexes at: closure nilToken]. + indexes at: anObject ifPresent: [:index | ^index]. + path := closure isDebugging ifTrue: [closure reversePathOf: anObject]. + self error: 'slot of an object not found in closure' +! ! + +!JSONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +quoted: aSymbol + ^'"', aSymbol asString, '"' +! ! + +!JSONWriter methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +write + self generateIndexes. + stream nextPutAll: '{ '; crtab; nextPutAll: '"objects" : ['; crtab: 2. + self writeObjects. + stream crtab; nextPutAll: '],'; crtab; nextPutAll: '"imports" : ['; crtab: 2. + self writeImports. + stream crtab; nextPutAll: '],'; crtab; nextPutAll: '"exports" : ['; crtab: 2. + self writeExports. + stream crtab; nextPutAll: ']'; cr; nextPutAll: '}' +! ! + +!JSONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeExports + exports keys + do: [ :name | | object index | + object := exports at: name. + index := self indexOf: object. + stream + nextPutAll: '["'; + nextPutAll: name; + nextPutAll: '", ', index printString, ']' ] + separatedBy: [stream nextPutAll: ', '; crtab: 2] +! ! + +!JSONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeImport: aSymbolicReference + | elements | + stream + nextPutAll: '['; + nextPutAll: (self quoted: aSymbolicReference linker). + + aSymbolicReference token ifNotNil: [:token | + elements := token isString ifTrue: [{token}] ifFalse: [token]. + elements do: [:str | + stream + nextPutAll: ', '; + nextPutAll: (self quoted: str)]]. + stream nextPutAll: ']' +! ! + +!JSONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeImports + imports + do: [ :symref | self writeImport: symref ] + separatedBy: [stream nextPutAll: ', '; crtab: 2] +! ! + +!JSONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObject: obj + obj _isSmallInteger + ifTrue: [^stream nextPutAll: '3, ', obj printString]. + + self writeObjectBody: obj; writeObjectHeader: obj. +! ! + +!JSONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObjectBody: obj + obj _isBytes + ifTrue: [ self writeObjectBytes: obj ] + ifFalse: [ self writeObjectSlots: obj ] +! ! + +!JSONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObjectBytes: obj + | current aligned | + stream nextPutAll: '2, ['. + (1 to: obj _size) + do: [:i | stream nextPutAll: (obj _byteAt: i) printString] + separatedBy: [stream nextPutAll: ', ']. + stream nextPutAll: ']' +! ! + +!JSONWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObjectHeader: obj + | behavior | + behavior := self indexOf: obj behavior. + stream + nextPutAll: ', [', behavior printString, ', '; + nextPutAll: obj _hash printString; +" nextPutAll: 'flags : ', obj _flags printString;" + nextPutAll: ']'. +! ! + +!JSONWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObjectSlots: obj + stream nextPutAll: '1, ['. + (1 to: obj _pointersSize) + do: [ :i | | slot index | + slot := obj _basicAt: i. + index := self indexOf: slot. + stream nextPutAll: index printString ] + separatedBy: [stream nextPutAll: ', ']. + stream nextPutAll: ']' +! ! + +!JSONWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObjects + objects + do: [ :obj | + stream nextPut: $[. + self writeObject: obj. + stream nextPut: $] ] + separatedBy: [stream nextPut: $,; crtab: 2] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JSONWriter class' category: #JSONWriter! +JSONWriter class + instanceVariableNames: ''! + + +JSONWriter initialize! + diff --git a/modules/ImageSegmentBuilder/Metaclass.Extension.st b/modules/ImageSegmentBuilder/Metaclass.Extension.st new file mode 100644 index 00000000..4534e3cb --- /dev/null +++ b/modules/ImageSegmentBuilder/Metaclass.Extension.st @@ -0,0 +1,14 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Metaclass methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asSymbolicReference + ^SymbolicReference forMetaclass: self +! ! + +!Metaclass methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeStoredIn: anObjectClosure + ^anObjectClosure scope includes: class +! ! + + diff --git a/modules/ImageSegmentBuilder/Module.Extension.st b/modules/ImageSegmentBuilder/Module.Extension.st new file mode 100644 index 00000000..485489f6 --- /dev/null +++ b/modules/ImageSegmentBuilder/Module.Extension.st @@ -0,0 +1,29 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Module methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asSymbolicReference + ^SymbolicReference forModule: self +! ! + +!Module methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeStoredIn: anObjectClosure + ^anObjectClosure module == self +! ! + +!Module methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeImageSegmentUsing: aWriter + | builder | + builder := Builder new. + builder module: self; build. + ^aWriter + closure: builder closure; + objects: builder objects; + mapping: builder mapping; + imports: builder imports; + exports: self exports; + write; + image +! ! + + diff --git a/modules/ImageSegmentBuilder/Native/NativeModule.Class.st b/modules/ImageSegmentBuilder/Native/NativeModule.Class.st new file mode 100644 index 00000000..2b34c5bb --- /dev/null +++ b/modules/ImageSegmentBuilder/Native/NativeModule.Class.st @@ -0,0 +1,55 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #NativeModule category: #'Powerlang-Core-LMR'! +Module subclass: #NativeModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-LMR'! +!NativeModule commentStamp: '' prior: 0! + + Copyright (c) 2023-2024, Javier Pimás. + See (MIT) license in root directory. + + This module implements a writer that serializes Egg objects into a stream in a format that is + very similar to the format of objects in raw memory. Egg object format is decribed in detail + in Egg documentation. +! + +!NativeModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #Kernel -> #(Module HashTable IdentityDictionary ProtoObject). + #ImageSegmentBuilder -> #Writer + } +! ! + +!NativeModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + | names | + super initialize. + names := (ProtoObject classVarNamed: #ObjectBitsMasks). + names ifNil: [self _halt]. + NativeWriter addNamespace: names. +! ! + +!NativeModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +newWriter + ^NativeWriter new +! ! + +!NativeModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +fileExtension + "Egg Module Snapshot" + ^'ems' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NativeModule class' category: #'Powerlang-Core-LMR'! +NativeModule class + instanceVariableNames: ''! + + +NativeModule initialize! + diff --git a/modules/ImageSegmentBuilder/Native/NativeWriter.Class.st b/modules/ImageSegmentBuilder/Native/NativeWriter.Class.st new file mode 100644 index 00000000..3f634d54 --- /dev/null +++ b/modules/ImageSegmentBuilder/Native/NativeWriter.Class.st @@ -0,0 +1,345 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #NativeWriter category: #Native! +Writer subclass: #NativeWriter + instanceVariableNames: 'importStrings offsets size base wordSize' + classVariableNames: '' + poolDictionaries: '' + category: 'Native'! +!NativeWriter commentStamp: '' prior: 0! + + Copyright (c) 2022-2024, Javier Pimás. + See (MIT) license in root directory. +! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +base + " + Return preferred base address for this segment + " + ^ base +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +base: anInteger + " + Set the preferred base address for this segment. + This is a hint only, loaders may load a segment + at a different address but then they must relocate. + " + base := anInteger +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +closure: anObjectClosure + super closure: anObjectClosure. +! ! + +!NativeWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +addImportString: aSymbol + (importStrings includesKey: aSymbol) ifTrue: [^self]. + importStrings at: aSymbol put: importStrings size. +! ! + +!NativeWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeImportStrings + imports do: [:import | + self addImportString: import linker. + import token ifNotNil: [:token | + token isString + ifTrue: [self addImportString: token] + ifFalse: [token do: [:s | self addImportString: s]]] + ] +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +encodedReferenceTo: anObject + | key offset | + anObject _isSmallInteger + ifTrue: [ ^ anObject value * 2 + 1 ]. + + key := HashTable nilToken == anObject ifTrue: [closure nilToken] ifFalse: [anObject]. + offset := offsets at: key. + + (offset bitAnd: 0x2) == 0x2 ifTrue: [^offset]. + ^base + offset +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +image + ^stream contents +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + base := 0x1000000. + wordSize := 8. + importStrings := Dictionary new. + offsets := IdentityDictionary new. + stream := #[] writeStream +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectHeaderSizeInBytes: anObject + ^anObject _isLarge ifTrue: [16] ifFalse: [8] +! ! + +!NativeWriter methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectIsBytes: anObject + ^(anObject _basicFlags bitAnd: IsBytes) = IsBytes +! ! + +!NativeWriter methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectSize: anObject + ^anObject _isLarge + ifTrue: [anObject _largeSize] + ifFalse: [anObject _smallSize] +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectSizeInBytes: anObject + | total | + total := self objectSize: anObject. + ^(self objectIsBytes: anObject) + ifTrue: [total + wordSize - 1 bitAnd: 0 - wordSize] + ifFalse: [total * wordSize] +! ! + +!NativeWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +layoutImport: anObject at: anInteger + | encoded | + encoded := anInteger << 2 | 0x2. + offsets at: anObject put: encoded. +! ! + +!NativeWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +layoutObject: obj at: offset + | oop | + oop := offset + (self objectHeaderSizeInBytes: obj). + offsets at: obj put: oop. + ^oop + (self objectSizeInBytes: obj). +! ! + +!NativeWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +layoutObjects + | offset subscript | + offset := self objectsOffset. + objects + do: [ :obj | + obj _isSmallInteger ifFalse: [ + offset := self layoutObject: obj at: offset]]. + size := offset. + subscript := 0. + imports keysDo: [ :obj | self layoutImport: obj at: subscript. subscript := subscript + 1]. + mapping keysAndValuesDo: [:obj :surrogate | + offsets at: surrogate ifPresent: [:o | offsets at: obj put: o]]. +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectsOffset + ^self class objectsOffset +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +offsetOf: anObject + ^ offsets at: anObject +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +wordSize: anInteger + wordSize := anInteger +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +write + self + computeImportStrings; + layoutObjects; + writeSignature; + writeHeader; + writeObjects; + writeImportStrings; + writeImports; + writeExports +! ! + +!NativeWriter methodsFor: 'own services' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeExports + stream nextULongPut: exports size. + exports keys + do: [ :name | | object encoded | + object := exports at: name. + encoded := self encodedReferenceTo: object. + stream + nextULargePut: encoded; + nextULargePut: name size; + nextPutAll: name] +! ! + +!NativeWriter methodsFor: 'own services' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeHeader + "See ImageSegment.h in runtimes/cpp for structure of a segment header" + stream nextULargePut: base; nextULargePut: size; nextULargePut: size + 16r20000. + self writeReferenceTo: closure module +! ! + +!NativeWriter methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeImportLinker: linker + " + linker can be + " + linker ifNil: [^stream nextULongPut: 0]. + stream nextULongPut: 1; nextULongPut: linker size; nextPutAll: linker +! ! + +!NativeWriter methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeImportToken: token + " + token can be a string or a collection of strings. In first case, a + type 0 is put first, then strings. Else collection size (>0) is put + first. Then the strings. + " + token isString ifTrue: [^stream nextULongPut: 0; nextULongPut: token size; nextPutAll: token]. + stream nextULongPut: token size. + token + do: [:str | stream nextULongPut: str size; nextPutAll: str] +! ! + +!NativeWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeImport: aSymbolicReference + + | descriptor subscript | + descriptor := OrderedCollection with: aSymbolicReference linker. + aSymbolicReference token ifNotNil: [:token | + token isString + ifTrue: [descriptor add: token] + ifFalse: [descriptor addAll: token]]. + + stream nextULongPut: descriptor size. + descriptor do: [:str | + subscript := importStrings at: str. + stream nextULongPut: subscript]. +! ! + +!NativeWriter methodsFor: 'own services' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeImports + stream nextULongPut: imports size. + imports do: [ :symref | self writeImport: symref] +! ! + +!NativeWriter methodsFor: 'own services' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeImportStrings + | sorted | + sorted := Array new: importStrings size. + importStrings keysAndValuesDo: [:symref :subscript | sorted at: subscript + 1 put: symref]. + + stream nextULongPut: importStrings size. + sorted do: [ :string | + stream nextULongPut: string size; nextPutAll: string ] +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObjectBody: obj + (self objectIsBytes: obj) + ifTrue: [ self writeObjectBytes: obj ] + ifFalse: [ self writeObjectSlots: obj ] +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObjectBytes: obj + | initial written size misalignment padding | + initial := stream position. + stream nextPutAll: obj. + written := stream position - initial. + + size := self objectSize: obj. + size - written timesRepeat: [ stream nextPut: 0 ]. + + misalignment := size bitAnd: wordSize - 1. + misalignment = 0 ifTrue: [^self]. + + padding := wordSize - misalignment. + padding timesRepeat: [ stream nextPut: 0 ] +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObjectHeader: obj + | smallsize behavior | + obj _isLarge + ifTrue: [ + stream + nextULongPut: obj _largeSize; + nextULongPut: 0. + smallsize := 0] + ifFalse: [ + smallsize := obj _smallSize]. + behavior := self encodedReferenceTo: obj behavior. + stream + nextUShortPut: obj _basicHash; + nextPut: smallsize; + nextPut: obj _basicFlags; + nextULongPut: behavior. + self ASSERT: stream position == (self offsetOf: obj) +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObjectSlots: obj + 1 to: (self objectSize: obj) do: [ :i | self writeReferenceTo: (obj _basicAt: i) ]. +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObjects + self ASSERT: stream position == self objectsOffset. + objects do: [ :obj | + obj _isSmallInteger ifFalse: [ self writeObjectHeader: obj; writeObjectBody: obj ]] +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeReferenceTo: slot + | encoded | + encoded := self encodedReferenceTo: slot. + wordSize = 8 + ifFalse: [ self ASSERT: false ]. + stream nextULargePut: encoded +! ! + +!NativeWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeSignature + stream + nextPutAll: 'EGG_IS' asByteArray; + nextPut: Character lf asInteger; + nextPut: 0 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NativeWriter class' category: #Native! +NativeWriter class + instanceVariableNames: ''! + +!NativeWriter class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +behaviorOffset + " + The offset at which the behavior is from the oop (negated) + " + + ^ -4 +! ! + +!NativeWriter class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +nilOffset + ^self objectsOffset + 8 +! ! + +!NativeWriter class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectsOffset + " + The offset at which header terminates and objects are stored. + See ImageSegment.h in runtime/cpp for structure of a segment header + " + ^40 +! ! + + +NativeWriter initialize! + diff --git a/modules/ImageSegmentBuilder/Object.Extension.st b/modules/ImageSegmentBuilder/Object.Extension.st new file mode 100644 index 00000000..75196ad9 --- /dev/null +++ b/modules/ImageSegmentBuilder/Object.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Object methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeStoredIn: anObjectClosure + ^true +! ! + + diff --git a/modules/ImageSegmentBuilder/ObjectClosure.Class.st b/modules/ImageSegmentBuilder/ObjectClosure.Class.st new file mode 100644 index 00000000..ea66577b --- /dev/null +++ b/modules/ImageSegmentBuilder/ObjectClosure.Class.st @@ -0,0 +1,159 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ObjectClosure category: #ImageSegmentBuilder! +Object subclass: #ObjectClosure + instanceVariableNames: 'queue added objects mapping boundary scope builder nilToken reversePaths debug' + classVariableNames: '' + poolDictionaries: '' + category: 'ImageSegmentBuilder'! +!ObjectClosure commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!ObjectClosure methodsFor: 'closure' stamp: 'KenD 28/Jun/2026 13:27:39'! +traverse: anObject + | obj | + queue add: anObject. + [ queue isEmpty ] + whileFalse: [ + obj := queue removeFirst. + self addSlotsOf: obj ] +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +scope: classes + scope addAll: classes +! ! + +!ObjectClosure methodsFor: 'degugging' stamp: 'KenD 28/Jun/2026 13:27:39'! +activateDebugMode + debug := true. + reversePaths := IdentityDictionary new: 100. +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addBoundary: anObject + self addBoundary: anObject as: anObject asSymbolicReference +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addBoundary: anObject as: aSymbolicReference + boundary at: anObject put: aSymbolicReference +! ! + +!ObjectClosure methodsFor: 'closure' stamp: 'KenD 28/Jun/2026 13:27:39'! +addSlotsOf: anObject + self analyze: anObject behavior from: anObject. + 1 to: anObject _pointersSize do: [ :i | | slot | + slot := anObject _basicAt: i. + self analyze: slot from: anObject] +! ! + +!ObjectClosure methodsFor: 'closure' stamp: 'KenD 28/Jun/2026 13:27:39'! +analyze: anObject from: source + | surrogate | + surrogate := self surrogateFor: anObject. + (boundary includesKey: surrogate) ifTrue: [^self]. + (added includes: surrogate) ifTrue: [^self]. + (surrogate shouldBeStoredIn: self) ifFalse: [^self addBoundary: surrogate]. + self isDebugging ifTrue: [reversePaths at: anObject put: source]. + added add: surrogate. + objects add: surrogate. + queue add: surrogate. +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +boundary + ^boundary +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +builder + ^builder +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +builder: aBuilder + builder := aBuilder +! ! + +!ObjectClosure methodsFor: 'degugging' stamp: 'KenD 28/Jun/2026 13:27:39'! +isDebugging + ^debug +! ! + +!ObjectClosure methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + mapping := IdentityDictionary new. + queue := OrderedCollection new: 2000. + added := IdentitySet new: 2000. + objects := OrderedCollection new: 2000. + boundary := IdentityDictionary new: 100. + nilToken := Object new. + scope := Set new. + debug := false. +! ! + +!ObjectClosure methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +map: anObject to: anotherObject + mapping at: anObject put: anotherObject +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +mapping + ^mapping +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +module + ^builder module +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +nilToken + ^nilToken +! ! + +!ObjectClosure methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +objects + ^objects +! ! + +!ObjectClosure methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:27:39'! +reversePathOf: anObject + | path current | + path := OrderedCollection new. + current:= anObject. + [ + path add: current. + current := reversePaths at: current ifAbsent: [^path]. + ] repeat +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +roots: aCollection + roots := aCollection +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +scope + ^scope +! ! + +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +surrogateFor: anObject + anObject == HashTable nilToken ifTrue: [^nilToken]. + ^mapping at: anObject ifAbsent: [anObject] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ObjectClosure class' category: #ImageSegmentBuilder! +ObjectClosure class + instanceVariableNames: ''! + + +ObjectClosure initialize! + diff --git a/modules/ImageSegmentBuilder/Symbol.Extension.st b/modules/ImageSegmentBuilder/Symbol.Extension.st new file mode 100644 index 00000000..c0d45319 --- /dev/null +++ b/modules/ImageSegmentBuilder/Symbol.Extension.st @@ -0,0 +1,14 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Symbol methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asSymbolicReference + ^SymbolicReference forSymbol: self +! ! + +!Symbol methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeStoredIn: anObjectClosure + ^anObjectClosure module == Kernel +! ! + + diff --git a/modules/ImageSegmentBuilder/True.Extension.st b/modules/ImageSegmentBuilder/True.Extension.st new file mode 100644 index 00000000..97f87f99 --- /dev/null +++ b/modules/ImageSegmentBuilder/True.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!True methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asSymbolicReference + ^SymbolicReference new linker: #true +! ! + + diff --git a/modules/ImageSegmentBuilder/UndefinedObject.Extension.st b/modules/ImageSegmentBuilder/UndefinedObject.Extension.st new file mode 100644 index 00000000..18732a10 --- /dev/null +++ b/modules/ImageSegmentBuilder/UndefinedObject.Extension.st @@ -0,0 +1,14 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!UndefinedObject methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asSymbolicReference + ^SymbolicReference new linker: #nil +! ! + +!UndefinedObject methodsFor: '*snapshotting' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeStoredIn: anObjectClosure + ^anObjectClosure module == Kernel +! ! + + diff --git a/modules/ImageSegmentBuilder/Writer.Class.st b/modules/ImageSegmentBuilder/Writer.Class.st new file mode 100644 index 00000000..80b91e82 --- /dev/null +++ b/modules/ImageSegmentBuilder/Writer.Class.st @@ -0,0 +1,78 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #Writer category: #Writer! +Object subclass: #Writer + instanceVariableNames: 'stream objects mapping imports exports closure' + classVariableNames: '' + poolDictionaries: '' + category: 'Writer'! +!Writer commentStamp: '' prior: 0! + + Copyright (c) 2022-2023, Javier Pimás. + See (MIT) license in root directory. +! + +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +closure: anObjectClosure + closure := anObjectClosure +! ! + +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +objects: aCollection + objects := aCollection +! ! + +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +mapping: aDictionary + mapping := aDictionary +! ! + +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports: anIdentityDictionary + imports := anIdentityDictionary +! ! + +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +exports: aDictionary + exports := aDictionary +! ! + +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +image + ^stream contents +! ! + +!Writer methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + stream := '' writeStream. +! ! + +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +stream: aWriteStream + stream := aWriteStream +! ! + +!Writer methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +write + self subclassResponsibility +! ! + +!Writer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeTo: aStream + self stream: aStream; write. +! ! + +!Writer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeToFile: filename + filename binaryWriteStreamDo: [ :s | self writeTo: byteStream ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Writer class' category: #Writer! +Writer class + instanceVariableNames: ''! + + +Writer initialize! + diff --git a/modules/JSON/BooleanAdaptor.Class.st b/modules/JSON/BooleanAdaptor.Class.st new file mode 100644 index 00000000..4fb069d3 --- /dev/null +++ b/modules/JSON/BooleanAdaptor.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #BooleanAdaptor category: #JSON! +DataAdaptor subclass: #BooleanAdaptor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!BooleanAdaptor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!BooleanAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +dataFrom: aBoolean + ^aBoolean ifTrue: [1] ifFalse: [0] +! ! + +!BooleanAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectFrom: anInteger + ^anInteger asBoolean +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BooleanAdaptor class' category: #JSON! +BooleanAdaptor class + instanceVariableNames: ''! + + diff --git a/modules/JSON/DataAdaptor.Class.st b/modules/JSON/DataAdaptor.Class.st new file mode 100644 index 00000000..de3bf22a --- /dev/null +++ b/modules/JSON/DataAdaptor.Class.st @@ -0,0 +1,38 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #DataAdaptor category: #JSON! +Object subclass: #DataAdaptor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!DataAdaptor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!DataAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +dataFrom: anObject + ^anObject asString +! ! + +!DataAdaptor methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isEntityAdaptor + ^false +! ! + +!DataAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectFrom: aString + ^(aString conform: [:ch | ch isDigit or: [#($+ $- $.) includes: ch]]) + ifTrue: [aString asNumber] + ifFalse: [aString] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'DataAdaptor class' category: #JSON! +DataAdaptor class + instanceVariableNames: ''! + + diff --git a/modules/JSON/IdAdaptor.Class.st b/modules/JSON/IdAdaptor.Class.st new file mode 100644 index 00000000..248f25aa --- /dev/null +++ b/modules/JSON/IdAdaptor.Class.st @@ -0,0 +1,52 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #IdAdaptor category: #JSON! +DataAdaptor subclass: #IdAdaptor + instanceVariableNames: 'selector' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!IdAdaptor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!IdAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +dataFrom: anObject + anObject isNil ifTrue: [^nil]. + anObject isInteger ifTrue: [^anObject]. + anObject isString ifTrue: [^anObject]. + ^selector evaluateWith: anObject +! ! + +!IdAdaptor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:41'! +initialize + super initialize. + selector := #id +! ! + +!IdAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectFrom: anInteger + ^anInteger +! ! + +!IdAdaptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +selector: aSymbol + selector := aSymbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IdAdaptor class' category: #JSON! +IdAdaptor class + instanceVariableNames: ''! + +!IdAdaptor class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +forName + ^self new selector: #name +! ! + + +IdAdaptor initialize! + diff --git a/modules/JSON/JsonAnySchema.Class.st b/modules/JSON/JsonAnySchema.Class.st new file mode 100644 index 00000000..f03ee789 --- /dev/null +++ b/modules/JSON/JsonAnySchema.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonAnySchema category: #JSON! +JsonCombinedSchema subclass: #JsonAnySchema + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonAnySchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonAnySchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isAnySchema + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonAnySchema class' category: #JSON! +JsonAnySchema class + instanceVariableNames: ''! + +!JsonAnySchema class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +typeName + ^'anyOf' +! ! + + diff --git a/modules/JSON/JsonArraySchema.Class.st b/modules/JSON/JsonArraySchema.Class.st new file mode 100644 index 00000000..7c1ef206 --- /dev/null +++ b/modules/JSON/JsonArraySchema.Class.st @@ -0,0 +1,85 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonArraySchema category: #JSON! +JsonSchema subclass: #JsonArraySchema + instanceVariableNames: 'items minItems maxItems uniqueItems' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonArraySchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonArraySchema methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:41'! +asJson + | json | + json := super asJson. + items notNil ifTrue: [json items: items asJson]. + minItems notNil ifTrue: [json at: 'minItems' put: minItems]. + maxItems notNil ifTrue: [json at: 'maxItems' put: maxItems]. + ^json +! ! + +!JsonArraySchema methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:41'! +initialize + super initialize. + uniqueItems := false +! ! + +!JsonArraySchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isArraySchema + ^true +! ! + +!JsonArraySchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +items + ^items +! ! + +!JsonArraySchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +items: aJsonSchema + items := aJsonSchema. + aJsonSchema parent: self +! ! + +!JsonArraySchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +maxItems + ^maxItems +! ! + +!JsonArraySchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +maxItems: aNumber + maxItems := aNumber +! ! + +!JsonArraySchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +minItems + ^minItems +! ! + +!JsonArraySchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +minItems: aNumber + minItems := aNumber +! ! + +!JsonArraySchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +uniqueItems + ^uniqueItems +! ! + +!JsonArraySchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +uniqueItems: aBoolean + uniqueItems := aBoolean +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonArraySchema class' category: #JSON! +JsonArraySchema class + instanceVariableNames: ''! + + +JsonArraySchema initialize! + diff --git a/modules/JSON/JsonBooleanSchema.Class.st b/modules/JSON/JsonBooleanSchema.Class.st new file mode 100644 index 00000000..3b7af2f1 --- /dev/null +++ b/modules/JSON/JsonBooleanSchema.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonBooleanSchema category: #JSON! +JsonPrimitiveSchema subclass: #JsonBooleanSchema + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonBooleanSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonBooleanSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isBooleanSchema + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonBooleanSchema class' category: #JSON! +JsonBooleanSchema class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonCombinedSchema.Class.st b/modules/JSON/JsonCombinedSchema.Class.st new file mode 100644 index 00000000..4f2eecb6 --- /dev/null +++ b/modules/JSON/JsonCombinedSchema.Class.st @@ -0,0 +1,37 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonCombinedSchema category: #JSON! +JsonSchema subclass: #JsonCombinedSchema + instanceVariableNames: 'schemas' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonCombinedSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonCombinedSchema methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:41'! +asJson + ^JsonObject new at: self typeName put: schemas; yourself +! ! + +!JsonCombinedSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +schemas + ^schemas +! ! + +!JsonCombinedSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +schemas: aCollection + schemas := aCollection. + aCollection do: [:schema | schema parent: self] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonCombinedSchema class' category: #JSON! +JsonCombinedSchema class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonDateFormat.Class.st b/modules/JSON/JsonDateFormat.Class.st new file mode 100644 index 00000000..8f434a31 --- /dev/null +++ b/modules/JSON/JsonDateFormat.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonDateFormat category: #JSON! +JsonStringFormat subclass: #JsonDateFormat + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonDateFormat commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonDateFormat class' category: #JSON! +JsonDateFormat class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonDateTimeFormat.Class.st b/modules/JSON/JsonDateTimeFormat.Class.st new file mode 100644 index 00000000..0ced8518 --- /dev/null +++ b/modules/JSON/JsonDateTimeFormat.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonDateTimeFormat category: #JSON! +JsonStringFormat subclass: #JsonDateTimeFormat + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonDateTimeFormat commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonDateTimeFormat class' category: #JSON! +JsonDateTimeFormat class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonEmailFormat.Class.st b/modules/JSON/JsonEmailFormat.Class.st new file mode 100644 index 00000000..b38ceeb3 --- /dev/null +++ b/modules/JSON/JsonEmailFormat.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonEmailFormat category: #JSON! +JsonStringFormat subclass: #JsonEmailFormat + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonEmailFormat commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonEmailFormat class' category: #JSON! +JsonEmailFormat class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonError.Class.st b/modules/JSON/JsonError.Class.st new file mode 100644 index 00000000..1665d09f --- /dev/null +++ b/modules/JSON/JsonError.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonError category: #JSON! +Error subclass: #JsonError + instanceVariableNames: 'position context' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonError commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +context: aString + context := aString +! ! + +!JsonError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +description + ^'Cannot parse the JSON stream around ' , context storeString , ' because ' + , super description +! ! + +!JsonError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +position + ^position +! ! + +!JsonError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +position: anInteger + position := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonError class' category: #JSON! +JsonError class + instanceVariableNames: ''! + +!JsonError class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +signal: aString at: anInteger + ^self new position: anInteger; description: aString; signal +! ! + +!JsonError class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +signal: aString at: anInteger context: context + ^self new + position: anInteger; + description: aString; + context: context; + signal +! ! + + diff --git a/modules/JSON/JsonFormat.Class.st b/modules/JSON/JsonFormat.Class.st new file mode 100644 index 00000000..36255d38 --- /dev/null +++ b/modules/JSON/JsonFormat.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonFormat category: #JSON! +Object subclass: #JsonFormat + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonFormat commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonFormat class' category: #JSON! +JsonFormat class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonImporter.Class.st b/modules/JSON/JsonImporter.Class.st new file mode 100644 index 00000000..0a59f141 --- /dev/null +++ b/modules/JSON/JsonImporter.Class.st @@ -0,0 +1,108 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonImporter category: #JSON! +Object subclass: #JsonImporter + instanceVariableNames: 'parser metadata contents filename' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonImporter commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonImporter methodsFor: 'importing' stamp: 'KenD 28/Jun/2026 13:27:41'! +checkContentsKey: aString value: aDictionary + aString = 'Contents' + ifFalse: [self error: 'the Contents key is not defined as the second one']. + contents := aDictionary +! ! + +!JsonImporter methodsFor: 'importing' stamp: 'KenD 28/Jun/2026 13:27:41'! +checkKey: key value: value index: index + index = 1 ifTrue: [^self checkMetadataKey: key value: value]. + index = 2 ifTrue: [^self checkContentsKey: key value: value]. + index > 2 ifTrue: [^self failBecause: 'there are more keys than expected'] +! ! + +!JsonImporter methodsFor: 'importing' stamp: 'KenD 28/Jun/2026 13:27:41'! +checkMetadataKey: aString value: aDictionary + | type version | + aString = 'Metadata' + ifFalse: [self + failBecause: 'the metadata is not defined as the first key of the file']. + type := aDictionary at: 'Type'. + (self validTypes includes: type) + ifFalse: [self failBecause: 'the defined Type is not valid']. + version := aDictionary at: 'Version'. + version <= self currentVersion ifFalse: [ + self + error: 'the version of the file is newer than the current application version']. + metadata := aDictionary +! ! + +!JsonImporter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +contentsOf: aFilename + | file | + file := aFilename asFilename asFile. + ^file exists ifTrue: [file binaryContents] +! ! + +!JsonImporter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +currentVersion + ^self subclassResponsibility +! ! + +!JsonImporter methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:41'! +failBecause: aString + | description | + description := 'Could not import ' , filename asString , ' because ' + , aString. + JsonImporterError signal: description +! ! + +!JsonImporter methodsFor: 'importing' stamp: 'KenD 28/Jun/2026 13:27:41'! +importFrom: aFilename + | index | + self reset. + filename := aFilename. + self updateParser. + index := 1. + parser parseMapKeysAndValuesDo: [:key :value | + self checkKey: key value: value index: index. + index := index + 1]. + ^contents +! ! + +!JsonImporter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +reset + metadata := contents := parser := filename := nil +! ! + +!JsonImporter methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:41'! +updateParser + | data string | + data := self contentsOf: filename. + data notNil ifTrue: [ + string := String fromUTF8: data. + parser := JsonParser on: string readStream] +! ! + +!JsonImporter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +validTypes + ^self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonImporter class' category: #JSON! +JsonImporter class + instanceVariableNames: ''! + +!JsonImporter class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +importFrom: aFilename + ^self new importFrom: aFilename +! ! + + diff --git a/modules/JSON/JsonImporterError.Class.st b/modules/JSON/JsonImporterError.Class.st new file mode 100644 index 00000000..131f70a6 --- /dev/null +++ b/modules/JSON/JsonImporterError.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonImporterError category: #JSON! +Error subclass: #JsonImporterError + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonImporterError commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonImporterError class' category: #JSON! +JsonImporterError class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonIntegerFormat.Class.st b/modules/JSON/JsonIntegerFormat.Class.st new file mode 100644 index 00000000..c6a91d87 --- /dev/null +++ b/modules/JSON/JsonIntegerFormat.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonIntegerFormat category: #JSON! +JsonNumberFormat subclass: #JsonIntegerFormat + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonIntegerFormat commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonIntegerFormat class' category: #JSON! +JsonIntegerFormat class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonIntegerSchema.Class.st b/modules/JSON/JsonIntegerSchema.Class.st new file mode 100644 index 00000000..2a80cdf4 --- /dev/null +++ b/modules/JSON/JsonIntegerSchema.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonIntegerSchema category: #JSON! +JsonNumberSchema subclass: #JsonIntegerSchema + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonIntegerSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonIntegerSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +defaultFormat + ^JsonIntegerFormat new +! ! + +!JsonIntegerSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isIntegerSchema + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonIntegerSchema class' category: #JSON! +JsonIntegerSchema class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonMapping.Class.st b/modules/JSON/JsonMapping.Class.st new file mode 100644 index 00000000..8071feff --- /dev/null +++ b/modules/JSON/JsonMapping.Class.st @@ -0,0 +1,220 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #JsonMapping category: #JSON! +Object subclass: #JsonMapping + instanceVariableNames: 'type class properties registry locator' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonMapping commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonMapping methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +classFrom: aDictionary + | subclass | + class isNil ifTrue: [^nil]. + subclass := (class hasSubclasses + and: [class respondsTo: #classForJsonDictionary:]) + ifTrue: [class classForJsonDictionary: aDictionary]. + ^subclass ifNil: [class] +! ! + +!JsonMapping methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromSchema: aJsonSchema + type := aJsonSchema. + properties := type properties + collect: [:property | JsonPropertyMap fromType: property mapping: self] +! ! + +!JsonMapping methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromType: anEdmType + type := anEdmType. + properties := type allProperties + collect: [:property | JsonPropertyMap fromType: property mapping: self] +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +get: key with: selector + self get: key with: selector adaptor: nil +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +get: key with: selector adaptor: adaptor + | map | + map := properties at: key ifAbsentPut: [self newMap name: key]. + map getter: selector -> adaptor +! ! + +!JsonMapping methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + properties := OrderedDictionary new +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +instanceFor: aDictionary + ^locator notNil ifTrue: [locator evaluateWith: aDictionary] +! ! + +!JsonMapping methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +jsonObjectFrom: anObject + ^self serializer jsonObjectFrom: anObject using: self +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +keys + ^type isEntityType + ifTrue: [properties select: [:p | p isKey]] + ifFalse: [properties] +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +locator: evaluableObject + locator := evaluableObject +! ! + +!JsonMapping methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +newMap + ^JsonPropertyMap new + property: EdmPropertyType new useDefaults; + mapping: self +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +objectClass + ^class +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +objectClass: aClass + class := aClass isSymbol + ifTrue: [ + Smalltalk at: aClass ifAbsent: [ + Notification signal: 'Class not found'. + JsonObject]] + ifFalse: [aClass isString + ifTrue: [Smalltalk classNamed: aClass] + ifFalse: [aClass]] +! ! + +!JsonMapping methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +objectFrom: aDictionary + ^self serializer + mappings: registry; + objectFrom: aDictionary using: self +! ! + +!JsonMapping methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + aStream + nextPutAll: type typeName; + nextPutAll: ' type → '; + nextPutAll: class name +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +properties + ^properties +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +propertyAt: aString + ^properties at: aString ifAbsent: nil +! ! + +!JsonMapping methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +read: aJsonObject into: anObject + self serializer + mappings: registry; + objectFrom: aJsonObject into: anObject using: self +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +registry + ^registry +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +registry: aJsonMappingRegistry + registry := aJsonMappingRegistry +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +removeProperty: aString + properties removeKey: aString ifAbsent: nil +! ! + +!JsonMapping methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +serializer + ^JsonSerializer new condition: true; mappings: registry +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +set: key with: selector + self set: key with: selector adaptor: nil +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +set: key with: selector adaptor: adaptor + | map | + map := properties at: key ifAbsentPut: [self newMap name: key]. + map setter: selector -> adaptor +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +type + ^type +! ! + +!JsonMapping methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +typeName + ^type typeName +! ! + +!JsonMapping methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +useDefaultGetters + properties do: #useDefaultGetter +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonMapping class' category: #JSON! +JsonMapping class + instanceVariableNames: ''! + +!JsonMapping class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +defaultFromSchema: aJsonSchema toClass: aClass + ^(self fromSchema: aJsonSchema toClass: aClass) useDefaultGetters +! ! + +!JsonMapping class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +defaultFromType: anEdmType toClass: aClass + ^(self fromType: anEdmType toClass: aClass) useDefaultGetters +! ! + +!JsonMapping class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromSchema: aJsonSchema + ^self fromSchema: aJsonSchema toClass: nil +! ! + +!JsonMapping class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromSchema: aJsonSchema toClass: aClass + ^self new fromSchema: aJsonSchema; objectClass: aClass +! ! + +!JsonMapping class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromType: anEdmType + ^self fromType: anEdmType toClass: nil +! ! + +!JsonMapping class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromType: anEdmType toClass: aClass + ^self new fromType: anEdmType; objectClass: aClass +! ! + + +JsonMapping initialize! + diff --git a/modules/JSON/JsonMappingRegistry.Class.st b/modules/JSON/JsonMappingRegistry.Class.st new file mode 100644 index 00000000..e3d7d32f --- /dev/null +++ b/modules/JSON/JsonMappingRegistry.Class.st @@ -0,0 +1,87 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonMappingRegistry category: #JSON! +Object subclass: #JsonMappingRegistry + instanceVariableNames: 'mappings classes' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonMappingRegistry commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonMappingRegistry methodsFor: 'mappings' stamp: 'KenD 28/Jun/2026 13:27:41'! +addMappingsFrom: aJsonMappingRegistry + aJsonMappingRegistry mappingsDo: [:mapping | self register: mapping] +! ! + +!JsonMappingRegistry methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:41'! +initialize + super initialize. + mappings := Dictionary new. + classes := Dictionary new +! ! + +!JsonMappingRegistry methodsFor: 'mappings' stamp: 'KenD 28/Jun/2026 13:27:41'! +mappingFor: anObject + ^self mappingForClass: anObject class +! ! + +!JsonMappingRegistry methodsFor: 'mappings' stamp: 'KenD 28/Jun/2026 13:27:41'! +mappingForClass: aClass + | class | + class := aClass. + [| mapping | + mapping := classes at: class name ifAbsent: nil. + mapping isNil ifTrue: [ + mapping := mappings detect: [:m | m objectClass == class] ifNone: nil. + mapping notNil ifTrue: [classes at: class name put: mapping]]. + mapping notNil ifTrue: [^mapping]. + class := class superclass. + class notNil] whileTrue. + ^nil +! ! + +!JsonMappingRegistry methodsFor: 'mappings' stamp: 'KenD 28/Jun/2026 13:27:41'! +mappingForType: anEdmType + ^mappings detect: [:m | m type = anEdmType] ifNone: nil +! ! + +!JsonMappingRegistry methodsFor: 'mappings' stamp: 'KenD 28/Jun/2026 13:27:41'! +mappingNamed: aString + ^mappings at: aString ifAbsent: nil +! ! + +!JsonMappingRegistry methodsFor: 'mappings' stamp: 'KenD 28/Jun/2026 13:27:41'! +mappingNamed: aString ifAbsentPut: aBlock + ^mappings at: aString ifAbsent: [self register: aBlock value] +! ! + +!JsonMappingRegistry methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +mappingsDo: aBlock + mappings do: aBlock +! ! + +!JsonMappingRegistry methodsFor: 'mappings' stamp: 'KenD 28/Jun/2026 13:27:41'! +register: aJsonMapping + ^self register: aJsonMapping withName: aJsonMapping typeName +! ! + +!JsonMappingRegistry methodsFor: 'mappings' stamp: 'KenD 28/Jun/2026 13:27:41'! +register: aJsonMapping withName: aString + aJsonMapping registry: self. + classes at: aJsonMapping objectClass name put: aJsonMapping. + ^mappings at: aString put: aJsonMapping +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonMappingRegistry class' category: #JSON! +JsonMappingRegistry class + instanceVariableNames: ''! + + +JsonMappingRegistry initialize! + diff --git a/modules/JSON/JsonModule.Class.st b/modules/JSON/JsonModule.Class.st new file mode 100644 index 00000000..9886b980 --- /dev/null +++ b/modules/JSON/JsonModule.Class.st @@ -0,0 +1,27 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonModule category: #JSON! +Module subclass: #JsonModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:41'! +imports + ^{ + #Kernel -> #(Character Error IdentitySet OrderedDictionary). + } +! ! + +!JsonModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:41'! +justLoaded + JsonWriter initializePools +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonModule class' category: #JSON! +JsonModule class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonNotSchema.Class.st b/modules/JSON/JsonNotSchema.Class.st new file mode 100644 index 00000000..4b25a93b --- /dev/null +++ b/modules/JSON/JsonNotSchema.Class.st @@ -0,0 +1,42 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonNotSchema category: #JSON! +JsonSchema subclass: #JsonNotSchema + instanceVariableNames: 'schema' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonNotSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonNotSchema methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:41'! +asJson + ^JsonObject new at: self typeName put: schema; yourself +! ! + +!JsonNotSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isNotSchema + ^true +! ! + +!JsonNotSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +schema + ^schema +! ! + +!JsonNotSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +schema: aJsonSchema + schema := aJsonSchema. + aJsonSchema parent: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonNotSchema class' category: #JSON! +JsonNotSchema class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonNullSchema.Class.st b/modules/JSON/JsonNullSchema.Class.st new file mode 100644 index 00000000..1eb15dc2 --- /dev/null +++ b/modules/JSON/JsonNullSchema.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonNullSchema category: #JSON! +JsonPrimitiveSchema subclass: #JsonNullSchema + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonNullSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonNullSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isNullSchema + ^true +! ! + +!JsonNullSchema methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:27:41'! +targetClass + ^UndefinedObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonNullSchema class' category: #JSON! +JsonNullSchema class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonNumberFormat.Class.st b/modules/JSON/JsonNumberFormat.Class.st new file mode 100644 index 00000000..af618cdf --- /dev/null +++ b/modules/JSON/JsonNumberFormat.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonNumberFormat category: #JSON! +JsonFormat subclass: #JsonNumberFormat + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonNumberFormat commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonNumberFormat class' category: #JSON! +JsonNumberFormat class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonNumberSchema.Class.st b/modules/JSON/JsonNumberSchema.Class.st new file mode 100644 index 00000000..f7a6eed7 --- /dev/null +++ b/modules/JSON/JsonNumberSchema.Class.st @@ -0,0 +1,113 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonNumberSchema category: #JSON! +JsonPrimitiveSchema subclass: #JsonNumberSchema + instanceVariableNames: 'minimum exclusiveMinimum maximum exclusiveMaximum multipleOf' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonNumberSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonNumberSchema methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:41'! +asJson + | json | + json := super asJson. + minimum notNil ifTrue: [ + json + at: 'minimum' put: minimum; + at: 'exclusiveMinimum' put: exclusiveMinimum]. + maximum notNil ifTrue: [ + json + at: 'maximum' put: maximum; + at: 'exclusiveMinimum' put: exclusiveMaximum]. + multipleOf notNil ifTrue: [json at: 'multipleOf' put: multipleOf]. + ^json +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +defaultFormat + ^JsonNumberFormat new +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +exclusiveMaximum + ^exclusiveMaximum ifTrue: [maximum] +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +exclusiveMaximum: anObject + anObject isNumber + ifTrue: [ + maximum := anObject. + exclusiveMaximum := true] + ifFalse: [exclusiveMaximum := anObject] +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +exclusiveMinimum + ^exclusiveMinimum ifTrue: [minimum] +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +exclusiveMinimum: anObject + anObject isNumber + ifTrue: [ + minimum := anObject. + exclusiveMinimum := true] + ifFalse: [exclusiveMinimum := anObject] +! ! + +!JsonNumberSchema methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:41'! +initialize + super initialize. + exclusiveMinimum := exclusiveMaximum := false +! ! + +!JsonNumberSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isNumberSchema + ^true +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +maximum + ^maximum +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +maximum: aNumber + maximum := aNumber +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +minimum + ^minimum +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +minimum: aNumber + minimum := aNumber +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +multipleOf + ^multipleOf +! ! + +!JsonNumberSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +multipleOf: anNumber + multipleOf := anNumber +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonNumberSchema class' category: #JSON! +JsonNumberSchema class + instanceVariableNames: ''! + + +JsonNumberSchema initialize! + diff --git a/modules/JSON/JsonObject.Class.st b/modules/JSON/JsonObject.Class.st new file mode 100644 index 00000000..5ba96884 --- /dev/null +++ b/modules/JSON/JsonObject.Class.st @@ -0,0 +1,93 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #JsonObject category: #JSON! +OrderedDictionary subclass: #JsonObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonObject commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:32:24'! +doesNotUnderstand: aMessage + | key | + (aMessage isBinary or: [aMessage arity > 1]) + ifTrue: [^super doesNotUnderstand: aMessage]. + key := aMessage selector asString. + aMessage arity = 0 ifTrue: [^self valueAt: key]. + self at: key allButLast put: aMessage argument +! ! + +!JsonObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +format + ^self asString +! ! + +!JsonObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isJsonObject + ^true +! ! + +!JsonObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +literals + | below here | + here := OrderedSet streamContents: [:strm | + below := OrderedCollection new. + self keysAndValuesDo: [:k :v | + k isString ifTrue: [ + strm nextPut: k. + v class == self class ifTrue: [below add: v]]]]. + ^here asArray , (below gather: #literals) asArray +! ! + +!JsonObject methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + self printOn: aStream indent: 0! ! + +!JsonObject methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream indent: anInteger + | string | + string := JsonWriter write: self indent: anInteger. + aStream eol = String crlf ifTrue: [string := string withCrLf]. + aStream isFileStream + ifTrue: [aStream nextBytesPut: string utf8] + ifFalse: [aStream nextPutAll: string] +! ! + +!JsonObject methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printTextOn: rtf + self printTextOn: rtf indent: 0! ! + +!JsonObject methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printTextOn: rtf indent: anInteger + JsonPainter write: self on: rtf indent: anInteger +! ! + +!JsonObject methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printTextOn: rtf limit: aNumber + self printTextOn: rtf indent: 0! ! + +!JsonObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +selectors + ^#() +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonObject class' category: #JSON! +JsonObject class + instanceVariableNames: ''! + +!JsonObject class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromString: aString + | json | + json := JsonParser parse: aString. + self ASSERT: json class == self. + ^json +! ! + + diff --git a/modules/JSON/JsonObjectSchema.Class.st b/modules/JSON/JsonObjectSchema.Class.st new file mode 100644 index 00000000..8288039d --- /dev/null +++ b/modules/JSON/JsonObjectSchema.Class.st @@ -0,0 +1,93 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonObjectSchema category: #JSON! +JsonSchema subclass: #JsonObjectSchema + instanceVariableNames: 'properties required additionalProperties' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonObjectSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonObjectSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +additionalProperties + ^additionalProperties +! ! + +!JsonObjectSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +additionalProperties: anObject + additionalProperties := anObject +! ! + +!JsonObjectSchema methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:41'! +addProperty: aString schema: aJsonSchema + properties at: aString put: aJsonSchema. + aJsonSchema parent: self +! ! + +!JsonObjectSchema methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:41'! +asJson + | json | + json := super asJson. + json at: 'properties' put: properties. + required notEmpty ifTrue: [json at: 'required' put: required]. + additionalProperties notEmpty + ifTrue: [json at: 'additionalProperties' put: additionalProperties]. + ^json +! ! + +!JsonObjectSchema methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:41'! +initialize + super initialize. + properties := Dictionary new. + required := OrderedCollection new. + additionalProperties := OrderedCollection new +! ! + +!JsonObjectSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isObjectSchema + ^true +! ! + +!JsonObjectSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +properties + ^properties +! ! + +!JsonObjectSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +propertyAt: aString + ^properties at: aString ifAbsent: nil +! ! + +!JsonObjectSchema methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:41'! +removeProperty: aString + properties remove: aString ifAbsent: nil +! ! + +!JsonObjectSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +required + ^required +! ! + +!JsonObjectSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +required: aCollection + required := aCollection +! ! + +!JsonObjectSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +requires: aString + ^required includes: aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonObjectSchema class' category: #JSON! +JsonObjectSchema class + instanceVariableNames: ''! + + +JsonObjectSchema initialize! + diff --git a/modules/JSON/JsonOneSchema.Class.st b/modules/JSON/JsonOneSchema.Class.st new file mode 100644 index 00000000..eeb1b7f2 --- /dev/null +++ b/modules/JSON/JsonOneSchema.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonOneSchema category: #JSON! +JsonCombinedSchema subclass: #JsonOneSchema + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonOneSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonOneSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isOneSchema + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonOneSchema class' category: #JSON! +JsonOneSchema class + instanceVariableNames: ''! + +!JsonOneSchema class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +typeName + ^'oneOf' +! ! + + diff --git a/modules/JSON/JsonPainter.Class.st b/modules/JSON/JsonPainter.Class.st new file mode 100644 index 00000000..b2d0eff6 --- /dev/null +++ b/modules/JSON/JsonPainter.Class.st @@ -0,0 +1,116 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonPainter category: #JSON! +JsonWriter subclass: #JsonPainter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonPainter commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonPainter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +codeForChar: ch + ^ch asInteger < 128 ifTrue: [super codeForChar: ch] ifFalse: [ch] +! ! + +!JsonPainter methodsFor: 'colors' stamp: 'KenD 28/Jun/2026 13:27:41'! +keyColor + ^Color darkGreen +! ! + +!JsonPainter methodsFor: 'colors' stamp: 'KenD 28/Jun/2026 13:27:41'! +keywordColor + self disableCode: [^Color red: 245 green: 100 blue: 71]. + ^Color darkBlue +! ! + +!JsonPainter methodsFor: 'colors' stamp: 'KenD 28/Jun/2026 13:27:41'! +literalColor + ^Color darkBlue +! ! + +!JsonPainter methodsFor: 'colors' stamp: 'KenD 28/Jun/2026 13:27:41'! +operatorColor + ^Color red: 185 green: 126 blue: 148! ! + +!JsonPainter methodsFor: 'colors' stamp: 'KenD 28/Jun/2026 13:27:41'! +specialColor + ^Color red: 245 green: 100 blue: 71! ! + +!JsonPainter methodsFor: 'colors' stamp: 'KenD 28/Jun/2026 13:27:41'! +stringColor + ^Color red: 84 green: 134 blue: 192! ! + +!JsonPainter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeBoolean: aBoolean + stream useColor: self literalColor while: [super writeBoolean: aBoolean] +! ! + +!JsonPainter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeDate: aDate + self writeString: aDate iso8601! ! + +!JsonPainter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeKey: aString + stream + useBoldWhile: [stream + useColor: self keyColor + while: [super writeKey: aString]] +! ! + +!JsonPainter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeNull + stream useColor: self specialColor while: [super writeNull] +! ! + +!JsonPainter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeNumber: aNumber + stream useColor: self literalColor while: [super writeNumber: aNumber] +! ! + +!JsonPainter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeOperator: aCharacter + stream + useColor: self operatorColor + while: [super writeOperator: aCharacter] +! ! + +!JsonPainter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeString: aString + stream useColor: self stringColor while: [super writeString: aString] +! ! + +!JsonPainter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeTimestamp: aTimestamp + stream + useColor: self literalColor + while: [super writeTimestamp: aTimestamp] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonPainter class' category: #JSON! +JsonPainter class + instanceVariableNames: ''! + +!JsonPainter class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +write: anObject + | text writer | + text := '' asText. + writer := self write: anObject on: text. + ^text +! ! + +!JsonPainter class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +write: anObject indent: anInteger + | text | + text := '' asText. + self write: anObject on: text indent: anInteger. + ^text +! ! + + diff --git a/modules/JSON/JsonParser.Class.st b/modules/JSON/JsonParser.Class.st new file mode 100644 index 00000000..b78f4931 --- /dev/null +++ b/modules/JSON/JsonParser.Class.st @@ -0,0 +1,295 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonParser category: #JSON! +Object subclass: #JsonParser + instanceVariableNames: 'stream' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +consumeWhitespace + [stream atEnd not and: [stream peek isBlank]] whileTrue: [stream next] +! ! + +!JsonParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:41'! +error: aString + ^JsonError signal: aString at: stream position context: stream context +! ! + +!JsonParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +expectChar: character + (self matchChar: character) ifFalse: [ + self + error: 'the character ' , character asString storeString + , ' rather than ' + , stream peek asString storeString + , ' was expected'] +! ! + +!JsonParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +match: string do: block + (string conform: [:ch | stream peekFor: ch]) ifTrue: [ + self consumeWhitespace. + block value] +! ! + +!JsonParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +matchChar: character + ^(stream peekFor: character) ifTrue: [self consumeWhitespace]; yourself +! ! + +!JsonParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +next + ^self parseValue +! ! + +!JsonParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +on: aReadStream + stream := aReadStream +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseCharacter + | char | + char := stream next. + char = $\ ifFalse: [^char]. + char := stream next. + ('/"\' includes: char) ifTrue: [^char]. + ('bfnrt' includes: char) ifTrue: [^self unescapeChar: char]. + char = $u ifTrue: [^self parseCharacterHex]. + self + error: 'the invalid escape character \' , char asString storeString + , ' occurred' +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseCharacterHex + | value codePoint | + value := self parseCharacterHex4Value. + (value < 16rD800 or: [value > 16rDBFF]) + ifTrue: [codePoint := value] + ifFalse: [| leadSurrogate trailSurrogate | + "Characters not in the Basic Multilingual Plane are encoded as a UTF-16 surrogate pair" + "See https://tools.ietf.org/html/rfc7159#section-7" + leadSurrogate := value. + trailSurrogate := self parseTrailingSurrogateHexEscape. + codePoint := leadSurrogate - 16rD800 * 16r400 + (trailSurrogate - 16rDC00). + codePoint := 16r10000 + codePoint]. + ^Character codePoint: codePoint +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseCharacterHex4Value + | value | + value := self parseCharacterHexDigit. + 3 timesRepeat: [value := (value bitShift: 4) + self parseCharacterHexDigit]. + ^value +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseCharacterHexDigit + | digit char | + stream atEnd ifFalse: [ + char := stream next. + digit := char asInteger. + (digit between: "$0" 48 and: "$9" 57) ifTrue: [^digit - 48]. + (digit between: "$A" 65 and: "$F" 70) ifTrue: [^digit - 55]. + (digit between: "$a" 97 and: "$f" 102) ifTrue: [^digit - 87]]. + self + error: 'an hex-digit rather than ' , char asString storeString + , ' was expected' +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseConstantDo: block + stream peek = $t ifTrue: [^self match: 'true' do: [block value: true]]. + stream peek = $f ifTrue: [^self match: 'false' do: [block value: false]]. + stream peek = $n ifTrue: [^self match: 'null' do: [block value: nil]] +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseList + ^Array + streamContents: [:strm | self + parseListElementsDo: [:each | strm nextPut: each]] +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseListDo: block + self expectChar: $[. + (self matchChar: $]) ifTrue: [^self]. + [stream atEnd] whileFalse: [ + block value. + (self matchChar: $]) ifTrue: [^self]. + self expectChar: $,]. + self error: 'an end of list was expected' +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseListElementsDo: block + self parseListDo: [block value: self parseValue] +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseMap + | map | + map := JsonObject new. + self parseMapKeysAndValuesDo: [:key :value | map at: key put: value]. + ^map +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseMapDo: block + self expectChar: ${. + (self matchChar: $}) ifTrue: [^self]. + [stream atEnd] whileFalse: [ + block value. + (self matchChar: $}) ifTrue: [^self]. + self expectChar: $,]. + self error: 'an end of map was expected' +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseMapKeysAndValuesDo: block + self parseMapKeysDo: [:key | block value: key value: self parseValue] +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseMapKeysDo: block + self parseMapDo: [| key | + key := self parsePropertyName. + self expectChar: $:. + block value: key] +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseNumber + | negated number | + negated := stream peekFor: $-. + number := self parseNumberInteger. + (stream peekFor: $.) ifTrue: [number := number + self parseNumberFraction]. + ((stream peekFor: $e) or: [stream peekFor: $E]) + ifTrue: [number := number * self parseNumberExponent]. + negated ifTrue: [number := number negated]. + self consumeWhitespace. + ^number +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseNumberExponent + | number negated | + number := 0. + (negated := stream peekFor: $-) ifFalse: [stream peekFor: $+]. + [stream atEnd not and: [stream peek isDigit]] + whileTrue: [number := 10 * number + stream next digitValue]. + negated ifTrue: [number := number negated]. + ^10 raisedTo: number +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseNumberFraction + | number power | + number := 0. + power := 1.0. + [stream atEnd not and: [stream peek isDigit]] whileTrue: [ + number := 10 * number + stream next digitValue. + power := power * 10.0]. + ^number / power +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseNumberInteger + | number | + number := nil. + [stream atEnd not and: [stream peek isDigit]] + whileTrue: [number := 10 * (number ifNil: [0]) + stream next digitValue]. + number ifNil: [self error: 'an integer digit was expected']. + ^number +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parsePropertyName + | name | + name := self parseValue. + name isString ifTrue: [^name]. + self + error: 'a property name must be a string, not ' + , name asString withArticle +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseString + | result | + self expectChar: $". + result := String streamContents: [:strm | + [stream atEnd or: [stream peek = $"]] + whileFalse: [strm nextPutChar: self parseCharacter]]. + self expectChar: $". + ^result +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseTrailingSurrogateHexEscape + (stream next = $\ and: [stream next = $u]) + ifTrue: [^self parseCharacterHex4Value]. + self error: 'a trailing surrogate hex escape was expected' +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parseValue + | char | + stream atEnd ifTrue: [^self error: 'End of stream'] ifFalse: [ + char := stream peek. + char = ${ ifTrue: [^self parseMap]. + char = $[ ifTrue: [^self parseList]. + char = $" ifTrue: [^self parseString]. + (char = $- or: [char isDigit]) ifTrue: [^self parseNumber]. + self parseConstantDo: [:value | ^value]]. + ^self error: 'the character ' , char name , ' is invalid' +! ! + +!JsonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +unescapeChar: char + char = $b ifTrue: [^Character backspace]. + char = $f ifTrue: [^Character newPage]. + char = $n ifTrue: [^Character lf]. + char = $r ifTrue: [^Character cr]. + char = $t ifTrue: [^Character tab]. + self + error: 'the unknown escape character ' , char asString storeString + , ' occured' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonParser class' category: #JSON! +JsonParser class + instanceVariableNames: ''! + +!JsonParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +on: aReadStream + ^self new on: aReadStream; yourself +! ! + +!JsonParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +parse: aString + | parser string | + string := aString isByteArray + ifTrue: [UTF8 decode: aString] + ifFalse: [aString]. + parser := self on: string readStream. + ^parser next +! ! + +!JsonParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +parse: aString for: aForeignNode + ^self parse: aString trimBlanks +! ! + + diff --git a/modules/JSON/JsonPrimitiveSchema.Class.st b/modules/JSON/JsonPrimitiveSchema.Class.st new file mode 100644 index 00000000..c1c27aa5 --- /dev/null +++ b/modules/JSON/JsonPrimitiveSchema.Class.st @@ -0,0 +1,46 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonPrimitiveSchema category: #JSON! +JsonSchema subclass: #JsonPrimitiveSchema + instanceVariableNames: 'format' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonPrimitiveSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonPrimitiveSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +defaultFormat + ^self subclassResponsibility +! ! + +!JsonPrimitiveSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +format + ^format ifNil: [self defaultFormat] +! ! + +!JsonPrimitiveSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +format: anObject + format := anObject +! ! + +!JsonPrimitiveSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isPrimitiveSchema + ^true +! ! + +!JsonPrimitiveSchema methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:27:41'! +targetClass + ^Smalltalk at: self typeName asProperNoun asSymbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonPrimitiveSchema class' category: #JSON! +JsonPrimitiveSchema class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonPropertyMap.Class.st b/modules/JSON/JsonPropertyMap.Class.st new file mode 100644 index 00000000..367a908f --- /dev/null +++ b/modules/JSON/JsonPropertyMap.Class.st @@ -0,0 +1,169 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonPropertyMap category: #JSON! +Object subclass: #JsonPropertyMap + instanceVariableNames: 'property getter setter mapping' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonPropertyMap commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +adaptor: aDataAdaptor + self getterAdaptor: aDataAdaptor; setterAdaptor: aDataAdaptor +! ! + +!JsonPropertyMap methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +defaultGetter + | default class identifier | + default := property name asSymbol. + class := mapping objectClass. + class isNil ifTrue: [^default]. + (class canUnderstand: default) ifTrue: [^default]. + default first isUppercase ifFalse: [^default]. + identifier := default asIdentifier. + ^(class canUnderstand: identifier) ifTrue: [identifier] ifFalse: [default] +! ! + +!JsonPropertyMap methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +defaultSetter + ^(getter key , ':') asSymbol -> getter value +! ! + +!JsonPropertyMap methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +fromType: anEdmPropertyType + property := anEdmPropertyType. + getter := property name asSymbol -> nil +! ! + +!JsonPropertyMap methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +getFrom: anObject + | value adaptor | + value := getter key evaluateWith: anObject. + value isNil ifTrue: [^nil]. + adaptor := getter value. + adaptor isNil ifTrue: [^value]. + ^self isArrayed + ifTrue: [value collect: [:element | adaptor dataFrom: element]] + ifFalse: [adaptor dataFrom: value] +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +getter: anAssociation + getter := anAssociation +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +getterAdaptor: aDataAdaptor + getter notNil ifTrue: [getter value: aDataAdaptor] +! ! + +!JsonPropertyMap methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isArrayed + ^property isArrayed +! ! + +!JsonPropertyMap methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isKey + ^property isKey +! ! + +!JsonPropertyMap methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isOptional + ^property isOptional +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +mapping: aJsonMapping + mapping := aJsonMapping +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +name + ^property name +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +name: aString + property name: aString +! ! + +!JsonPropertyMap methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectFrom: value + | adaptor | + adaptor := self setter value. + ^adaptor isNil ifTrue: [value] ifFalse: [adaptor objectFrom: value] +! ! + +!JsonPropertyMap methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:41'! +printOn: aStream + aStream nextPut: $#; nextPutAll: getter key printString. + getter value ifNotNil: [:adaptor | + aStream nextPut: $(. + adaptor printOn: aStream. + aStream nextPut: $)]. + aStream nextPut: $→; nextPutAll: property name +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +property + ^property +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +property: anEdmPropertyType + property := anEdmPropertyType +! ! + +!JsonPropertyMap methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +set: value to: anObject + | adaptor adapted | + adaptor := self setter value. + adapted := adaptor isNil ifTrue: [value] ifFalse: [ + self isArrayed + ifTrue: [value collect: [:element | adaptor objectFrom: element]] + ifFalse: [adaptor objectFrom: value]]. + self setter key evaluateWith: anObject with: adapted +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +setter + ^setter ifNil: [self defaultSetter] +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +setter: anAssociation + setter := anAssociation +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +setterAdaptor: aDataAdaptor + setter notNil ifTrue: [setter value: aDataAdaptor] +! ! + +!JsonPropertyMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +type + ^property type +! ! + +!JsonPropertyMap methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +useDefaultGetter + getter key: self defaultGetter +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonPropertyMap class' category: #JSON! +JsonPropertyMap class + instanceVariableNames: ''! + +!JsonPropertyMap class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +fromType: anEdmPropertyType mapping: aJsonMapping + ^JsonPropertyMap new mapping: aJsonMapping; fromType: anEdmPropertyType +! ! + + diff --git a/modules/JSON/JsonSchema.Class.st b/modules/JSON/JsonSchema.Class.st new file mode 100644 index 00000000..1f5664e1 --- /dev/null +++ b/modules/JSON/JsonSchema.Class.st @@ -0,0 +1,286 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonSchema category: #JSON! +Object subclass: #JsonSchema + instanceVariableNames: 'title description default examples enum definitions parent' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonSchema methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:41'! +addDefinition: aJsonSchema named: aString + definitions at: aString put: aJsonSchema. + aJsonSchema parent: self +! ! + +!JsonSchema methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:41'! +asJson + | json | + json := JsonObject new. + json type: self typeName. + definitions notEmpty ifTrue: [json at: 'definitions' put: definitions]. + enum notNil ifTrue: [json at: 'enum' put: enum]. + default notNil ifTrue: [json at: 'default' put: default]. + examples notEmpty ifTrue: [json at: 'examples' put: examples]. + ^json +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +default + ^default +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +default: anObject + default := anObject +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +definitionNamed: aString + definitions at: aString ifPresent: [:s | ^s]. + ^parent notNil ifTrue: [parent definitionNamed: aString] +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +description + ^description +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +description: aString + description := aString +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +enum + ^enum +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +enum: aCollection + enum := aCollection +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +examples + ^examples +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +examples: aCollection + examples := aCollection +! ! + +!JsonSchema methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:41'! +initialize + super initialize. + examples := OrderedCollection new. + definitions := Dictionary new +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isAnySchema + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isArraySchema + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isBooleanSchema + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isIntegerSchema + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isNotSchema + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isNullSchema + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isNumberSchema + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isObjectSchema + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isOneSchema + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isPrimitiveSchema + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isSchemaReference + ^false +! ! + +!JsonSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isStringSchema + ^false +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +name + ^title +! ! + +!JsonSchema methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:41'! +not + ^JsonNotSchema new schema: self +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parent + ^parent +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +parent: aJsonSchema + parent := aJsonSchema +! ! + +!JsonSchema methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:41'! +printOn: aStream + self asJson printOn: aStream +! ! + +!JsonSchema methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:41'! +printTextOn: rtf + self asJson printTextOn: rtf +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +title + ^title +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +title: aString + title := aString +! ! + +!JsonSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +typeName + ^self class typeName +! ! + +!JsonSchema methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:27:41'! +validate: aJsonObject + ^JsonObjectValidator validate: aJsonObject against: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonSchema class' category: #JSON! +JsonSchema class + instanceVariableNames: ''! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +anyOf: aCollection + ^JsonAnySchema new schemas: aCollection +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +array + ^JsonArraySchema new +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +arrayOf: aJsonSchema + ^JsonArraySchema new items: aJsonSchema +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +boolean + ^JsonBooleanSchema new +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +integer + ^JsonIntegerSchema new +! ! + +!JsonSchema class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isAbstract + ^self = JsonSchema +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +multipleOf: aNumber + ^JsonNumberSchema new multipleOf: aNumber +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +not: aJsonSchema + ^JsonNotSchema new schema: aJsonSchema +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +null + ^JsonNullSchema new +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +number + ^JsonNumberSchema new +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +object + ^JsonObjectSchema new +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +oneOf: aCollection + ^JsonOneSchema new schemas: aCollection +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +ref: aString + ^JsonSchemaReference path: aString +! ! + +!JsonSchema class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +string + ^JsonStringSchema new +! ! + +!JsonSchema class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +typeName + ^((self name trimPrefix: 'Json') trimTail: 'Schema') asLowercase +! ! + +!JsonSchema class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +typeNamed: aString + ^self allSubclasses + detect: [:c | c isAbstract not and: [c typeName = aString]] + ifNone: [self error: 'Type named ' , aString asString , ' not found'] +! ! + + +JsonSchema initialize! + diff --git a/modules/JSON/JsonSchemaReference.Class.st b/modules/JSON/JsonSchemaReference.Class.st new file mode 100644 index 00000000..b75c0157 --- /dev/null +++ b/modules/JSON/JsonSchemaReference.Class.st @@ -0,0 +1,84 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #JsonSchemaReference category: #JSON! +Object subclass: #JsonSchemaReference + instanceVariableNames: 'path' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonSchemaReference commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonSchemaReference methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:24'! +asJson + ^path +! ! + +!JsonSchemaReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isLocal + ^path beginsWith: '#' +! ! + +!JsonSchemaReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isSchemaReference + ^true +! ! + +!JsonSchemaReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +parent: aJsonSchema + " + do nothing + " + ! ! + +!JsonSchemaReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +path + ^path +! ! + +!JsonSchemaReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +path: aString + path := aString +! ! + +!JsonSchemaReference methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + path printOn: aStream +! ! + +!JsonSchemaReference methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:32:24'! +resolveIn: aJsonSchema + | segments schema i | + self ASSERT: self isLocal. + segments := $/ split: path allButFirst. + segments := segments reject: #isEmpty. + schema := aJsonSchema. + i := 1. + [i <= segments size] whileTrue: [| segment | + segment := segments at: i. + schema := segment = 'definitions' + ifTrue: [ + i = segments size ifTrue: [^nil]. + i := i + 1. + schema definitionNamed: (segments at: i)] + ifFalse: [schema propertyAt: segment]. + schema isNil ifTrue: [^nil]. + i := i + 1]. + ^schema +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonSchemaReference class' category: #JSON! +JsonSchemaReference class + instanceVariableNames: ''! + +!JsonSchemaReference class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +path: aString + ^self new path: aString +! ! + + diff --git a/modules/JSON/JsonSerializer.Class.st b/modules/JSON/JsonSerializer.Class.st new file mode 100644 index 00000000..718c7152 --- /dev/null +++ b/modules/JSON/JsonSerializer.Class.st @@ -0,0 +1,219 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonSerializer category: #JSON! +Object subclass: #JsonSerializer + instanceVariableNames: 'mappings level condition' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonSerializer commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonSerializer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +condition: aBlock + condition := aBlock +! ! + +!JsonSerializer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +defaultDictionaryFrom: anObject + | dictionary | + dictionary := Dictionary new. + dictionary at: 'Class' put: anObject class name. + anObject class allInstVarNames do: [:key | | ivar | + ivar := anObject instVarNamed: key. + dictionary at: key put: ivar]. + ^dictionary +! ! + +!JsonSerializer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +getObject: aJsonPropertyMap from: aJsonObject + | key value mapping type | + key := aJsonPropertyMap name. + value := aJsonPropertyMap isOptional + ifTrue: [aJsonObject valueAt: key] + ifFalse: [aJsonObject at: key]. + value isNil ifTrue: [^nil]. + type := aJsonPropertyMap type singleType. + type isBasicType ifTrue: [^value]. + mapping := self mappingForType: type. + ^self objectFrom: value using: mapping +! ! + +!JsonSerializer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +getProperty: aJsonPropertyMap from: anObject + | value | + value := aJsonPropertyMap getFrom: anObject. + value isNil ifTrue: [^nil]. + ^self jsonFrom: value +! ! + +!JsonSerializer methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +inflate: aString + ^self inflate: aString using: nil +! ! + +!JsonSerializer methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +inflate: aString using: aJsonMapping + | json | + json := [JsonParser parse: aString] on: JsonError do: []. + json isNil ifTrue: [^nil]. + ^self objectFrom: json using: aJsonMapping +! ! + +!JsonSerializer methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:41'! +initialize + super initialize. + level := 0. + self upToLevel: 2! ! + +!JsonSerializer methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isLeaf: anObject + anObject isUndefinedValue ifTrue: [^true]. + anObject isNumber ifTrue: [^true]. + anObject isString ifTrue: [^true]. + anObject isBoolean ifTrue: [^true]. + anObject isDate ifTrue: [^true]. + anObject isTimestamp ifTrue: [^true]. + ^false +! ! + +!JsonSerializer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +jsonFrom: anObject + (self isLeaf: anObject) ifTrue: [^anObject]. + anObject isCollection ifTrue: [ + ^anObject collect: [:element | | d | + level := level + 1. + d := self jsonFrom: element. + level := level - 1. + d]]. + ^self jsonObjectFrom: anObject +! ! + +!JsonSerializer methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +jsonObjectFrom: anObject + | mapping | + anObject isJsonObject ifTrue: [^anObject]. + mapping := self mappingForObject: anObject. + mapping notNil ifTrue: [^self jsonObjectFrom: anObject using: mapping]. + (anObject respondsTo: #asJson) ifTrue: [^anObject asJson]. + ^self defaultDictionaryFrom: anObject +! ! + +!JsonSerializer methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +jsonObjectFrom: anObject using: aJsonMapping + | json | + json := JsonObject new. + aJsonMapping properties do: [:p | + level := level + 1. + self writeProperty: p from: anObject into: json. + level := level - 1]. + ^json notEmpty ifTrue: [json] +! ! + +!JsonSerializer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +mappingForObject: anObject + ^mappings notNil ifTrue: [mappings mappingFor: anObject] +! ! + +!JsonSerializer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +mappingForType: anEdmType + ^mappings notNil ifTrue: [mappings mappingForType: anEdmType] +! ! + +!JsonSerializer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +mappings: aJsonMappingRegistry + mappings := aJsonMappingRegistry +! ! + +!JsonSerializer methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectFrom: aJsonObject into: anObject using: aJsonMapping + aJsonMapping properties + do: [:p | self readProperty: p from: aJsonObject into: anObject]. + ^anObject +! ! + +!JsonSerializer methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectFrom: anObject using: aJsonMapping + | class mapping object | + (self isLeaf: anObject) ifTrue: [^anObject]. + anObject isSequenceableCollection ifTrue: [ + ^anObject collect: [:element | | o | + level := level + 1. + o := self objectFrom: element using: aJsonMapping. + level := level - 1. + o]]. + self ASSERT: anObject isDictionary. + aJsonMapping isNil ifTrue: [^anObject]. + class := aJsonMapping classFrom: anObject. + class isNil ifTrue: [^anObject]. + mapping := class == aJsonMapping objectClass + ifTrue: [aJsonMapping] + ifFalse: [(mappings mappingForClass: class) ifNil: [aJsonMapping]]. + object := (mapping instanceFor: anObject) ifNil: [class new]. + level := level + 1. + self objectFrom: anObject into: object using: mapping. + level := level - 1. + ^object +! ! + +!JsonSerializer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +onlyKeys + self upToLevel: 1! ! + +!JsonSerializer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +onlyKeysFromLevel: anInteger + self upToLevel: anInteger +! ! + +!JsonSerializer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +readProperty: aJsonPropertyMap from: aJsonObject into: anObject + | object | + object := self getObject: aJsonPropertyMap from: aJsonObject. + (object isNil and: [aJsonPropertyMap isOptional]) ifTrue: [^self]. + ((condition evaluateWith: level with: object) or: [aJsonPropertyMap isKey]) + ifTrue: [aJsonPropertyMap set: object to: anObject] +! ! + +!JsonSerializer methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +serialize: anObject + | json | + json := self jsonFrom: anObject. + ^JsonWriter write: json +! ! + +!JsonSerializer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +upToLevel: anInteger + condition := [:depth :object | depth <= anInteger] +! ! + +!JsonSerializer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeProperty: aJsonPropertyMap from: anObject into: aJsonObject + | value | + value := self getProperty: aJsonPropertyMap from: anObject. + (value isNil and: [aJsonPropertyMap isOptional]) ifTrue: [^self]. + ((condition evaluateWith: level with: anObject) or: [aJsonPropertyMap isKey]) + ifTrue: [aJsonObject at: aJsonPropertyMap name put: value] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonSerializer class' category: #JSON! +JsonSerializer class + instanceVariableNames: ''! + +!JsonSerializer class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +inflate: anObject + ^self new inflate: anObject +! ! + +!JsonSerializer class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +serialize: anObject + ^self new serialize: anObject +! ! + + +JsonSerializer initialize! + diff --git a/modules/JSON/JsonStringFormat.Class.st b/modules/JSON/JsonStringFormat.Class.st new file mode 100644 index 00000000..ed1ede77 --- /dev/null +++ b/modules/JSON/JsonStringFormat.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonStringFormat category: #JSON! +JsonFormat subclass: #JsonStringFormat + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonStringFormat commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonStringFormat class' category: #JSON! +JsonStringFormat class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonStringSchema.Class.st b/modules/JSON/JsonStringSchema.Class.st new file mode 100644 index 00000000..5dddf028 --- /dev/null +++ b/modules/JSON/JsonStringSchema.Class.st @@ -0,0 +1,60 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonStringSchema category: #JSON! +JsonPrimitiveSchema subclass: #JsonStringSchema + instanceVariableNames: 'minLength maxLength' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonStringSchema commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonStringSchema methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:41'! +asJson + | json | + json := super asJson. + minLength notNil ifTrue: [json at: 'minLength' put: minLength]. + maxLength notNil ifTrue: [json at: 'maxLength' put: maxLength]. + ^json +! ! + +!JsonStringSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +defaultFormat + ^JsonStringFormat new +! ! + +!JsonStringSchema methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isStringSchema + ^true +! ! + +!JsonStringSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +maxLength + ^maxLength +! ! + +!JsonStringSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +maxLength: anInteger + maxLength := anInteger +! ! + +!JsonStringSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +minLength + ^minLength +! ! + +!JsonStringSchema methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +minLength: anInteger + minLength := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonStringSchema class' category: #JSON! +JsonStringSchema class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonUriFormat.Class.st b/modules/JSON/JsonUriFormat.Class.st new file mode 100644 index 00000000..019fcd0d --- /dev/null +++ b/modules/JSON/JsonUriFormat.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonUriFormat category: #JSON! +JsonStringFormat subclass: #JsonUriFormat + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonUriFormat commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonUriFormat class' category: #JSON! +JsonUriFormat class + instanceVariableNames: ''! + + diff --git a/modules/JSON/JsonWriter.Class.st b/modules/JSON/JsonWriter.Class.st new file mode 100644 index 00000000..4f2b913c --- /dev/null +++ b/modules/JSON/JsonWriter.Class.st @@ -0,0 +1,336 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #JsonWriter category: #JSON! +Object subclass: #JsonWriter + instanceVariableNames: 'stream mappings indent visited sort' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!JsonWriter commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +addMappingsFrom: aJsonMappingRegistry + mappings addMappingsFrom: aJsonMappingRegistry +! ! + +!JsonWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +codeForChar: ch + | i code | + ('\"/' includes: ch) ifTrue: [^String with: $\ with: ch]. + ch = Bs ifTrue: [^'\b']. + ch = Ff ifTrue: [^'\f']. + ch = Lf ifTrue: [^'\n']. + ch = Cr ifTrue: [^'\r']. + ch = Tab ifTrue: [^'\t']. + i := ch asInteger. + i < 0x20 ifTrue: [ + code := i printPaddedWith: $0 to: 2 base: 16. + ^'\u00' , code]. + ^i < 128 ifTrue: [ch] ifFalse: [ch utf8 asString] +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +contents + ^stream contents +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +cr + stream cr; tab: indent +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +crtab + self cr; tab +! ! + +!JsonWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +indent: anInteger + indent := anInteger. + stream tab: indent +! ! + +!JsonWriter methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:41'! +initialize + super initialize. + mappings := JsonMappingRegistry new. + indent := 0. + sort := false +! ! + +!JsonWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +isBasic: anObject + anObject isUndefinedValue ifTrue: [^true]. + anObject isNumber ifTrue: [^true]. + anObject isString ifTrue: [^true]. + anObject isBoolean ifTrue: [^true]. + anObject isDate ifTrue: [^true]. + anObject isTimestamp ifTrue: [^true]. + ^false +! ! + +!JsonWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +jsonObjectFrom: anObject + anObject isJsonObject ifTrue: [^anObject]. + ^(self mappingFor: anObject) + ifNil: [JsonSerializer new mappings: mappings; jsonObjectFrom: anObject] + ifNotNil: [:mapping | mapping jsonObjectFrom: anObject] +! ! + +!JsonWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +mappingFor: anObject + mappings isNil ifTrue: [^anObject class defaultMapping]. + ^mappings mappingFor: anObject +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +nextWrite: aString + aString isCharacter ifTrue: [stream nextPut: aString] ifFalse: [ + self DENY: aString isWideString. + stream nextPutAll: aString] +! ! + +!JsonWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +on: aStream + stream := aStream. + indent := 0! ! + +!JsonWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +registry: aJsonMappingRegistry + mappings := aJsonMappingRegistry +! ! + +!JsonWriter methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +reset + stream reset. + indent := 0. + visited := nil +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +return + indent := indent - 1. + self cr +! ! + +!JsonWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +sortKeys: aBoolean + sort := aBoolean +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +space + stream space +! ! + +!JsonWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +tab + indent := indent + 1. + stream tab +! ! + +!JsonWriter methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +write: anObject + visited isNil ifTrue: [visited := IdentitySet new]. + anObject isNil ifTrue: [^self writeNull]. + anObject isNumber ifTrue: [^self writeNumber: anObject]. + anObject isString ifTrue: [^self writeString: anObject]. + anObject isBoolean ifTrue: [^self writeBoolean: anObject]. + anObject isDate ifTrue: [^self writeDate: anObject]. + anObject isTimestamp ifTrue: [^self writeTimestamp: anObject]. + anObject isFilename ifTrue: [^self writeFilename: anObject]. + anObject isExternalMemory ifTrue: [^self writeMemory: anObject]. + (visited includes: anObject) ifTrue: [^self writeVisitedObject: anObject]. + visited add: anObject. + [ + anObject isDictionary ifTrue: [^self writeDictionary: anObject]. + anObject isArray ifTrue: [^self writeArray: anObject]. + anObject isCollection ifTrue: [^self writeArray: anObject asArray]. + self writeObject: anObject] + ensure: [visited remove: anObject] +! ! + +!JsonWriter methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +write: anObject on: aStream + self on: aStream; reset; write: anObject +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeArray: anArray + self writeOperator: $[. + anArray notEmpty ifTrue: [ + self crtab. + anArray + do: [:object | self write: object] + separatedBy: [self writeOperator: $,; cr]. + self return]. + self writeOperator: $] +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeBoolean: aBoolean + self nextWrite: aBoolean printString +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeDate: aDate + self writeOperator: $". + aDate printIso8601On: stream. + self writeOperator: $"! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeDictionary: aDictionary + | keys | + self writeOperator: ${. + aDictionary keys size > 1 ifTrue: [self crtab]. + keys := aDictionary keys. + sort ifTrue: [keys := keys asArray sort]. + keys + do: [:key | | value | + value := aDictionary at: key. + self + writeKey: key; + writeOperator: $:; + space; + write: value] + separatedBy: [self writeOperator: $,; cr]. + aDictionary keys size > 1 ifTrue: [self return]. + self writeOperator: $}! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeFilename: aFilename + self writeString: aFilename asString +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeKey: aString + self writeString: aString +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeMemory: anExternalMemory + self writeArray: anExternalMemory bytes +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeNull + self nextWrite: 'null' +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeNumber: aNumber + | number | + aNumber isNaN ifTrue: [^self write: aNumber asString]. + aNumber isInfinite ifTrue: [^self write: aNumber asString]. + number := aNumber isFraction ifTrue: [aNumber asFloat] ifFalse: [aNumber]. + self nextWrite: number storeString +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeObject: anObject + | json | + json := self jsonObjectFrom: anObject. + self write: json +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeOperator: aCharacter + self nextWrite: aCharacter +! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeString: aString + self writeOperator: $". + aString do: [:ch | | code | + code := self codeForChar: ch. + self nextWrite: code]. + self writeOperator: $"! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeTimestamp: aTimestamp + stream nextPut: $". + aTimestamp printIso8601On: stream. + stream nextPut: $"! ! + +!JsonWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:41'! +writeVisitedObject: anObject + | d | + self error: 'Recursive'. + d := Dictionary new. + d at: 'Class' put: anObject class name. + d at: 'Already Visited' put: true. + anObject class allInstVarNames do: [:key | | ivar | + ivar := anObject instVarNamed: key. + (self isBasic: ivar) ifTrue: [ivar d at: key put: ivar]]. + self writeDictionary: d +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonWriter class' category: #JSON! +JsonWriter class + instanceVariableNames: ''! + +!JsonWriter class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +jsonObjectFrom: anObject + ^self new jsonObjectFrom: anObject +! ! + +!JsonWriter class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:41'! +initializePools + self addNamespace: Character namedCharacters +! ! + +!JsonWriter class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +on: aStream + ^self new on: aStream +! ! + +!JsonWriter class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +write: anObject + | stream writer | + stream := '' writeStream. + writer := self write: anObject on: stream. + ^String fromUTF8: writer contents +! ! + +!JsonWriter class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +write: anObject indent: anInteger + | stream writer | + stream := '' writeStream. + writer := self write: anObject on: stream indent: anInteger. + ^String fromUTF8: writer contents +! ! + +!JsonWriter class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +write: anObject on: aStream + ^self new on: aStream; write: anObject +! ! + +!JsonWriter class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +write: anObject on: aStream indent: anInteger + ^self new + on: aStream; + indent: anInteger; + write: anObject +! ! + +!JsonWriter class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +write: anObject registry: aJsonMappingRegistry + | stream writer | + stream := '' writeStream. + writer := self new. + writer + on: stream; + registry: aJsonMappingRegistry; + write: anObject. + ^String fromUTF8: writer contents +! ! + + +JsonWriter initialize! + diff --git a/modules/JSON/Object.Extension.st b/modules/JSON/Object.Extension.st new file mode 100644 index 00000000..bf1bb55c --- /dev/null +++ b/modules/JSON/Object.Extension.st @@ -0,0 +1,14 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! + + +!Object methodsFor: '*JSON' stamp: 'KenD 28/Jun/2026 13:27:41'! +isJsonObject + ^false +! ! + +!Object class methodsFor: '*JSON' stamp: 'KenD 28/Jun/2026 13:27:41'! +defaultMapping + ^nil +! ! + + diff --git a/modules/JSON/StringAdaptor.Class.st b/modules/JSON/StringAdaptor.Class.st new file mode 100644 index 00000000..f80891ea --- /dev/null +++ b/modules/JSON/StringAdaptor.Class.st @@ -0,0 +1,29 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #StringAdaptor category: #JSON! +DataAdaptor subclass: #StringAdaptor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!StringAdaptor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StringAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectFrom: anObject + | s | + anObject isString ifFalse: [^anObject]. + s := anObject trimBlanks. + ^s isEmpty ifFalse: [s] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'StringAdaptor class' category: #JSON! +StringAdaptor class + instanceVariableNames: ''! + + diff --git a/modules/JSON/SymbolAdaptor.Class.st b/modules/JSON/SymbolAdaptor.Class.st new file mode 100644 index 00000000..5c55ebc1 --- /dev/null +++ b/modules/JSON/SymbolAdaptor.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #SymbolAdaptor category: #JSON! +DataAdaptor subclass: #SymbolAdaptor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!SymbolAdaptor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!SymbolAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectFrom: aString + ^aString asSymbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SymbolAdaptor class' category: #JSON! +SymbolAdaptor class + instanceVariableNames: ''! + + diff --git a/modules/JSON/Tests/JsonMappingTest.Class.st b/modules/JSON/Tests/JsonMappingTest.Class.st new file mode 100644 index 00000000..c77c6b78 --- /dev/null +++ b/modules/JSON/Tests/JsonMappingTest.Class.st @@ -0,0 +1,65 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #JsonMappingTest category: #'JSON-Tests'! +TestCase subclass: #JsonMappingTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON-Tests'! +!JsonMappingTest commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonMappingTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:32:24'! +testTypeMapping + | type mapping json object | + type := EdmComplexType new. + type + name: 'point'; + addPropertyNamed: 'x' type: EdmType int; + addPropertyNamed: 'y' type: EdmType int. + mapping := JsonMapping fromType: type toClass: Point. + json := mapping jsonObjectFrom: 1 @ 2. + self + assert: json isJsonObject; + assert: (json at: 'x' ifAbsent: [self assert: false]) = 1; + assert: (json at: 'y' ifAbsent: [self assert: false]) = 2. + object := mapping objectFrom: json. + self assert: object = (1 @ 2) +! ! + +!JsonMappingTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:32:24'! +testTypesMapping + | registry point mapping rectangle example dictionary object serializer | + registry := JsonMappingRegistry new. + point := EdmComplexType new. + point + name: 'point'; + addPropertyNamed: 'x' type: EdmType int; + addPropertyNamed: 'y' type: EdmType int. + mapping := JsonMapping fromType: point toClass: Point. + registry register: mapping. + rectangle := EdmComplexType new. + rectangle + name: 'rectangle'; + addPropertyNamed: 'leftTop' type: point; + addPropertyNamed: 'rightBottom' type: point. + mapping := JsonMapping fromType: rectangle toClass: Rectangle. + registry register: mapping. + example := Rectangle origin: -10 @ 5 corner: 20 @ 10. + serializer := mapping serializer condition: true. + dictionary := serializer jsonObjectFrom: example. + self assert: dictionary isDictionary. + object := mapping objectFrom: dictionary. + self assert: object = example +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonMappingTest class' category: #'JSON-Tests'! +JsonMappingTest class + instanceVariableNames: ''! + + diff --git a/modules/JSON/Tests/JsonParserTest.Class.st b/modules/JSON/Tests/JsonParserTest.Class.st new file mode 100644 index 00000000..d1cbd2be --- /dev/null +++ b/modules/JSON/Tests/JsonParserTest.Class.st @@ -0,0 +1,43 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #JsonParserTest category: #'JSON-Tests'! +TestCase subclass: #JsonParserTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON-Tests'! +!JsonParserTest commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonParserTest methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +testJsonNode + | info | + info := Compiler + compile: 'm ^{"id": 1, "name": "john"}' + in: self class. + self + assert: (info ast statements anyone expression body ast + isKindOf: JsonObject) +! ! + +!JsonParserTest methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +testTP48846 + | wrong | + wrong := 'Page not found

Page not found

The requested URL was not found on this server.

Home
'. + self + should: [JsonParser parse: wrong] + raise: JsonError + satisfying: [:e | e isResumable not] + description: 'Default action' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonParserTest class' category: #'JSON-Tests'! +JsonParserTest class + instanceVariableNames: ''! + + diff --git a/modules/JSON/Tests/JsonSchemaTest.Class.st b/modules/JSON/Tests/JsonSchemaTest.Class.st new file mode 100644 index 00000000..5e9722f7 --- /dev/null +++ b/modules/JSON/Tests/JsonSchemaTest.Class.st @@ -0,0 +1,335 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #JsonSchemaTest category: #'JSON-Tests'! +TestCase subclass: #JsonSchemaTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON-Tests'! +!JsonSchemaTest commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testAnyOfValidation + | string number schema | + string := JsonSchema string maxLength: 5. + number := JsonSchema number minimum: 0. + schema := JsonSchema anyOf: {string. number}. + self + assert: (schema validate: 'short') hasPassed; + assert: (schema validate: 'too long') hasValidationFailures; + assert: (schema validate: 12) hasPassed; + assert: (schema validate: -5) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testArrayItemsValidation + | schema | + schema := JsonSchema arrayOf: JsonSchema number. + self + assert: (schema validate: #(1 2 3 4 5)) hasPassed; + assert: (schema validate: #(1 2 '3' 4 5)) hasValidationFailures; + assert: (schema validate: #()) hasPassed; + assert: (schema validate: 'abc') hasValidationFailures; + assert: (schema validate: nil) hasValidationFailures; + assert: (schema validate: true) hasValidationFailures; + assert: (schema validate: 123) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testArrayLengthValidation + | schema | + schema := JsonSchema arrayOf: JsonSchema number. + schema minItems: 2; maxItems: 3. + self + assert: (schema validate: #()) hasValidationFailures; + assert: (schema validate: #(1)) hasValidationFailures; + assert: (schema validate: #(1 2)) hasPassed; + assert: (schema validate: #(1 2 3)) hasPassed; + assert: (schema validate: #(1 2 3 4)) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testArrayUniquenessValidation + | schema | + schema := JsonSchema array. + schema uniqueItems: true. + self + assert: (schema validate: #(1 2 3 4 5)) hasPassed; + assert: (schema validate: #(1 2 3 3 4)) hasValidationFailures; + assert: (schema validate: #()) hasPassed +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testBooleanValidation + | schema | + schema := JsonSchema boolean. + self + assert: (schema validate: true) hasPassed; + assert: (schema validate: false) hasPassed; + assert: (schema validate: 'true') hasValidationFailures; + assert: (schema validate: 0) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testEnumValidation + | schema | + schema := JsonSchema string. + schema enum: #('red' 'amber' 'green'). + self + assert: (schema validate: 'red') hasPassed; + assert: (schema validate: 'blue') hasValidationFailures. + schema := JsonSchema new. + schema enum: {'red'. 'amber'. 'green'. nil. 42}. + self + assert: (schema validate: 'red') hasPassed; + assert: (schema validate: nil) hasPassed; + assert: (schema validate: 42) hasPassed; + assert: (schema validate: 0) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testIntegerValidation + | schema | + schema := JsonSchema integer. + self + assert: (schema validate: 42) hasPassed; + assert: (schema validate: -1) hasPassed; + assert: (schema validate: 3.1415926) hasValidationFailures; + assert: (schema validate: '42') hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testMultiple + | schema | + schema := JsonSchema number multipleOf: 10. + self + assert: (schema validate: 0) hasPassed; + assert: (schema validate: 10) hasPassed; + assert: (schema validate: 20) hasPassed; + assert: (schema validate: 23) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testNotValidation + | schema object | + schema := JsonSchema string not. + object := JsonObject with: 'key' -> 'value'. + self + assert: (schema validate: 42) hasPassed; + assert: (schema validate: object) hasPassed; + assert: (schema validate: 'I am a string') hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testNullValidation + | schema | + schema := JsonSchema null. + self + assert: (schema validate: nil) hasPassed; + assert: (schema validate: false) hasValidationFailures; + assert: (schema validate: 0) hasValidationFailures; + assert: (schema validate: '') hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testNumberRangeValidation + | schema | + schema := JsonSchema number minimum: 0; exclusiveMaximum: 100. + self + assert: (schema validate: -1) hasValidationFailures; + assert: (schema validate: 0) hasPassed; + assert: (schema validate: 10) hasPassed; + assert: (schema validate: 99) hasPassed; + assert: (schema validate: 100) hasValidationFailures; + assert: (schema validate: 101) hasValidationFailures. + schema := JsonSchema number + minimum: 0; + maximum: 100; + exclusiveMaximum: true. + self + assert: (schema validate: -1) hasValidationFailures; + assert: (schema validate: 0) hasPassed; + assert: (schema validate: 10) hasPassed; + assert: (schema validate: 99) hasPassed; + assert: (schema validate: 100) hasValidationFailures; + assert: (schema validate: 101) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testNumberValidation + | schema | + schema := JsonSchema number. + self + assert: (schema validate: 42) hasPassed; + assert: (schema validate: -1) hasPassed; + assert: (schema validate: 5.0) hasPassed; + assert: (schema validate: 2.99792458e8) hasPassed; + assert: (schema validate: '42') hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testObjectEnumValidation + | foo bar schema | + foo := JsonObject with: 'id' -> 1 with: 'name' -> 'foo'. + bar := JsonObject with: 'id' -> 2 with: 'name' -> 'bar'. + schema := JsonSchema object enum: {foo. bar}. + self + assert: (schema validate: foo) hasPassed; + assert: (schema validate: bar) hasPassed; + assert: (schema validate: JsonObject new) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testObjectValidation + | schema person car | + schema := JsonSchema object + addProperty: 'name' schema: JsonSchema string; + addProperty: 'age' schema: JsonSchema integer. + person := JsonObject new. + person + at: 'name' put: 'william'; + at: 'age' put: 42. + car := JsonObject new. + car at: 'brand' put: 'chevrolet'. + self + assert: (schema validate: person) hasPassed; + assert: (schema validate: JsonObject new) hasPassed; + assert: (schema validate: car) hasPassed; + assert: (schema validate: nil) hasValidationFailures; + assert: (schema validate: true) hasValidationFailures; + assert: (schema validate: 'abc') hasValidationFailures; + assert: (schema validate: 123) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testOneOfValidation + | multiplesOf5 multiplesOf3 schema | + multiplesOf5 := JsonSchema number multipleOf: 5. + multiplesOf3 := JsonSchema number multipleOf: 3. + schema := JsonSchema oneOf: {multiplesOf5. multiplesOf3}. + self + assert: (schema validate: 10) hasPassed; + assert: (schema validate: 9) hasPassed; + assert: (schema validate: 2) hasValidationFailures; + assert: (schema validate: 15) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testReferenceResolution + | address person reference | + address := JsonSchema object + addProperty: 'street_address' schema: JsonSchema string; + addProperty: 'city' schema: JsonSchema string; + addProperty: 'state' schema: JsonSchema string. + person := JsonSchema object + addProperty: 'name' schema: JsonSchema string; + addProperty: 'address' schema: address. + reference := JsonSchemaReference path: '#/address'. + self + assert: reference isLocal; + assert: (reference resolveIn: person) = address. + reference := JsonSchemaReference path: '#/address/city'. + self + assert: reference isLocal; + assert: (reference resolveIn: person) isStringSchema +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testReferenceValidation + | schema valid invalid | + schema := JsonSchema object + addProperty: 'name' schema: JsonSchema string; + addProperty: 'nickname' schema: (JsonSchema ref: '#/name'). + valid := JsonParser + parse: + { + "name": "william", + "nickname": "will" + } + . + invalid := JsonParser + parse: + { + "name": "william", + "nickname": 33 + } + . + self + assert: (schema validate: valid) hasPassed; + assert: (schema validate: invalid) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testReferenceValidation2 + | reference person schema valid invalid | + reference := JsonSchema ref: '#/definitions/person'. + person := JsonSchema object + addProperty: 'name' schema: JsonSchema string; + addProperty: 'children' + schema: (JsonSchema arrayOf: reference). + schema := JsonSchema object + addDefinition: person named: 'person'; + addProperty: 'person' schema: reference. + valid := JsonParser + parse: + {"person": { + "name": "homer", + "children": [ + {"name": "bart"}, + {"name": "lisa"} + ] + }} + . + self assert: (schema validate: valid) hasPassed. + invalid := JsonParser + parse: + {"person": { + "name": "homer", + "children": [ + true, + 0, + "abc" + ] + }} + . + self assert: (schema validate: invalid) hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testStringLengthValidation + | schema | + schema := JsonSchema string. + schema minLength: 2; maxLength: 3. + self + assert: (schema validate: 'A') hasValidationFailures; + assert: (schema validate: 'AB') hasPassed; + assert: (schema validate: 'ABC') hasPassed; + assert: (schema validate: 'ABCD') hasValidationFailures +! ! + +!JsonSchemaTest methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:32:24'! +testStringValidation + | schema | + schema := JsonSchema string. + self + assert: (schema validate: 'This is a string') hasPassed; + assert: (schema validate: 'Déjà vu') hasPassed; + assert: (schema validate: '42') hasPassed; + assert: (schema validate: 42) hasValidationFailures; + assert: (schema validate: nil) hasValidationFailures; + assert: (schema validate: true) hasValidationFailures; + assert: (schema validate: false) hasValidationFailures; + assert: (schema validate: 123) hasValidationFailures +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonSchemaTest class' category: #'JSON-Tests'! +JsonSchemaTest class + instanceVariableNames: ''! + + diff --git a/modules/JSON/Tests/JsonSerializationTest.Class.st b/modules/JSON/Tests/JsonSerializationTest.Class.st new file mode 100644 index 00000000..a4b81438 --- /dev/null +++ b/modules/JSON/Tests/JsonSerializationTest.Class.st @@ -0,0 +1,249 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #JsonSerializationTest category: #'JSON-Tests'! +TestCase subclass: #JsonSerializationTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON-Tests'! +!JsonSerializationTest commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonSerializationTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:32:24'! +testBasicSerialization + | serialized inflated | + serialized := JsonSerializer serialize: #(true 1 'a'). + self assert: serialized = '[ + true, + 1, + "a" +]'. + inflated := JsonSerializer inflate: serialized. + self assert: inflated = #(true 1 'a') +! ! + +!JsonSerializationTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:32:24'! +testInflate + | mappings class mapping serializer dictionary json copy | + mappings := JsonMappingRegistry new. + class := EdmEntityType new. + class + name: 'class'; + addKeyNamed: 'name' type: EdmType string; + addPropertyNamed: 'subclasses' type: (EdmArrayType of: class); + addPropertyNamed: 'format' type: EdmType integer; + addPropertyNamed: 'instanceVariables' + type: (EdmArrayType of: EdmType string). + mapping := JsonMapping fromType: class toClass: Class. + mapping + get: 'name' with: #symbol; + set: 'name' with: #name: adaptor: SymbolAdaptor new; + get: 'subclasses' with: #subclasses; + get: 'instanceVariables' with: #instVarNames; + set: 'instanceVariables' with: #instVarNames:; + get: 'format' with: #format. + mapping + locator: [:dict | (Smalltalk at: (dict at: 'name') asSymbol) objectShallowCopy]. + mappings register: mapping. + serializer := mapping serializer onlyKeysFromLevel: 2. + dictionary := serializer jsonObjectFrom: HashedCollection. + json := JsonWriter write: dictionary. + copy := serializer inflate: json using: mapping. + self + assert: copy !!== HashedCollection; + assert: copy name = HashedCollection name; + assert: copy format = HashedCollection format; + assert: copy instVarNames = HashedCollection instVarNames. + copy subclasses with: HashedCollection subclasses do: [:c :d | + self + assert: c !!== d; + assert: c name = d name; + assert: c format = d format; + assert: c instVarNames = d instVarNames. + c subclasses with: d subclasses do: [:e :f | self assert: e == f]] +! ! + +!JsonSerializationTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:32:24'! +testInflate2 + | mappings class mapping serializer dictionary json copy | + mappings := JsonMappingRegistry new. + class := EdmEntityType new. + class + name: 'class'; + addKeyNamed: 'name' type: EdmType string; + addPropertyNamed: 'subclasses' type: (EdmArrayType of: class); + addPropertyNamed: 'format' type: EdmType integer; + addPropertyNamed: 'instanceVariables' + type: (EdmArrayType of: EdmType string). + mapping := JsonMapping fromType: class toClass: Class. + mapping + get: 'name' with: #symbol; + set: 'name' with: #name: adaptor: SymbolAdaptor new; + get: 'subclasses' with: #subclasses; + get: 'instanceVariables' with: #instVarNames; + set: 'instanceVariables' with: #instVarNames:; + get: 'format' with: #format. + mapping + locator: [:dict | (Smalltalk at: (dict at: 'name') asSymbol) objectShallowCopy]. + mappings register: mapping. + serializer := mapping serializer onlyKeysFromLevel: 3. + dictionary := serializer jsonObjectFrom: HashedCollection. + json := JsonWriter write: dictionary. + copy := serializer inflate: json using: mapping. + self + assert: copy !!== HashedCollection; + assert: copy name = HashedCollection name; + assert: copy format = HashedCollection format; + assert: copy instVarNames = HashedCollection instVarNames. + copy subclasses with: HashedCollection subclasses do: [:c :d | + self + assert: c !!== d; + assert: c name = d name; + assert: c format = d format; + assert: c instVarNames = d instVarNames. + c subclasses with: d subclasses do: [:e :f | self assert: e !!== f]] +! ! + +!JsonSerializationTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:32:24'! +testKeysFromLevel + | mappings t1 mapping t2 t3 object serializer dictionary | + mappings := JsonMappingRegistry new. + t1 := EdmEntityType new. + t1 + name: 't1'; + addKeyNamed: 'id' type: EdmType integer; + addPropertyNamed: 'name' type: EdmType string. + mapping := JsonMapping fromType: t1 toClass: Association. + mapping + get: 'id' with: #key; + get: 'name' with: #value. + mappings register: mapping. + t2 := EdmComplexType new. + t2 + name: 't2'; + addPropertyNamed: 't1' type: t1. + mapping := JsonMapping fromType: t2 toClass: Object. + mapping get: 't1' with: #t1. + mappings register: mapping. + t3 := EdmComplexType new. + t3 + name: 't3'; + addPropertyNamed: 't1' type: t1; + addPropertyNamed: 't2' type: t2. + mapping := JsonMapping fromType: t3 toClass: Window. + mapping + get: 't1' with: #t1; + get: 't2' with: #t2. + mappings register: mapping. + object := Window new. + object + answerTo: #t1 with: 1 -> 'William'; + answerTo: #t2 with: (Object new answerTo: #t1 with: 2 -> 'Juliette'). + serializer := JsonSerializer new. + serializer mappings: mappings; onlyKeysFromLevel: 2. + dictionary := serializer jsonObjectFrom: object. + self + assert: ((dictionary valueAt: 't1') keys equalsTo: #('id' 'name')); + assert: (((dictionary valueAt: 't2') valueAt: 't1') keys equalsTo: #('id')) +! ! + +!JsonSerializationTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:32:24'! +testLevelCutting + | type mappings mapping object serializer dictionary | + type := EdmComplexType new. + type + name: 'type'; + addPropertyNamed: 'name' type: EdmType string; + addPropertyNamed: 'child' type: type. + mappings := JsonMappingRegistry new. + mapping := JsonMapping fromType: type toClass: Association. + mapping + get: 'name' with: #key; + get: 'child' with: #value. + mappings register: mapping. + object := 'a' -> ('b' -> ('c' -> 'd')). + serializer := mapping serializer upToLevel: 2. + dictionary := serializer jsonObjectFrom: object. + self + assert: (dictionary valueAt: 'name') = 'a'; + assert: (dictionary valueAt: 'child') notNil; + assert: ((dictionary valueAt: 'child') valueAt: 'name') = 'b'; + assert: ((dictionary valueAt: 'child') valueAt: 'child') isNil +! ! + +!JsonSerializationTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:32:24'! +testLevelCutting2 + | type mappings mapping object serializer dictionary | + type := EdmEntityType new. + type + name: 'type'; + addKeyNamed: 'name' type: EdmType string; + addPropertyNamed: 'index' type: EdmType integer; + addPropertyNamed: 'child' type: type. + mappings := JsonMappingRegistry new. + mapping := JsonMapping fromType: type toClass: Association. + mapping + get: 'name' with: #key; + get: 'index' with: [:assoc | assoc value key]; + get: 'child' with: [:assoc | assoc value value]. + mappings register: mapping. + object := 'a' -> (1 -> ('b' -> (2 -> ('c' -> (3 -> 'd'))))). + serializer := mapping serializer upToLevel: 2. + dictionary := serializer jsonObjectFrom: object. + self + assert: (dictionary valueAt: 'name') = 'a'; + assert: (dictionary valueAt: 'index') = 1; + assert: ((dictionary valueAt: 'child') valueAt: 'name') = 'b'; + assert: ((dictionary valueAt: 'child') valueAt: 'index') = 2; + assert: (((dictionary valueAt: 'child') valueAt: 'child') valueAt: 'name') = 'c'; + assert: (((dictionary valueAt: 'child') valueAt: 'child') valueAt: 'index') isNil; + assert: (((dictionary valueAt: 'child') valueAt: 'child') valueAt: 'child') isNil +! ! + +!JsonSerializationTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:32:24'! +testOnlyKeys + | mappings subtype mapping type object serializer dictionary | + mappings := JsonMappingRegistry new. + subtype := EdmEntityType new. + subtype + name: 'subtype'; + addKeyNamed: 'id' type: EdmType integer; + addPropertyNamed: 'name' type: EdmType string. + mapping := JsonMapping fromType: subtype toClass: Association. + mapping + get: 'id' with: #key; + get: 'name' with: #value. + mappings register: mapping. + type := EdmComplexType new. + type + name: 'type'; + addPropertyNamed: 'one' type: subtype; + addPropertyNamed: 'many' type: (EdmType arrayOf: subtype). + mapping := JsonMapping fromType: type toClass: Object. + mapping + get: 'one' with: #one; + get: 'many' with: #many. + mappings register: mapping. + object := Object new. + object + answerTo: #one with: 1 -> 'John'; + answerTo: #many + with: (Array with: 2 -> 'William' with: 3 -> 'Juliette'). + serializer := mapping serializer onlyKeys. + dictionary := serializer jsonObjectFrom: object. + self + assert: ((dictionary valueAt: 'one') keys equalsTo: #('id')); + assert: ((dictionary valueAt: 'many') + conform: [:d | d keys equalsTo: #('id')]) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonSerializationTest class' category: #'JSON-Tests'! +JsonSerializationTest class + instanceVariableNames: ''! + + diff --git a/modules/JSON/Tests/JsonWriterTest.Class.st b/modules/JSON/Tests/JsonWriterTest.Class.st new file mode 100644 index 00000000..5740a7bb --- /dev/null +++ b/modules/JSON/Tests/JsonWriterTest.Class.st @@ -0,0 +1,66 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #JsonWriterTest category: #'JSON-Tests'! +TestCase subclass: #JsonWriterTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON-Tests'! +!JsonWriterTest commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!JsonWriterTest methodsFor: 'utf8' stamp: 'KenD 28/Jun/2026 13:32:24'! +testEmbeddings + | text json read | + text := '\ b "Comment"'. + json := JsonWriter write: text. + read := JsonParser parse: json. + self assert: read = text. + text := '\ b + "Comment"'. + json := JsonWriter write: text. + read := JsonParser parse: json. + self assert: read = text +! ! + +!JsonWriterTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:32:24'! +testSingleLine + | object | + object := JsonObject new at: 'property' put: 123; yourself. + self assert: (JsonWriter write: object) = '{"property": 123}' +! ! + +!JsonWriterTest methodsFor: 'utf8' stamp: 'KenD 28/Jun/2026 13:32:24'! +testTP47626 + | date json | + date := Date yyyymmdd: '2017-10-28'. + json := JsonWriter write: date. + self assert: json = date iso8601 doubleQuoted +! ! + +!JsonWriterTest methodsFor: 'utf8' stamp: 'KenD 28/Jun/2026 13:32:24'! +testTP56387 + | json | + json := JsonObject new Name: 'Trulalá'. + self assert: (json asString includesString: 'Trulalá') +! ! + +!JsonWriterTest methodsFor: 'utf8' stamp: 'KenD 28/Jun/2026 13:32:24'! +testUTF8 + | text json read | + text := 'a → 3 + 4'. + json := JsonWriter write: text. + read := JsonParser parse: json. + self assert: read = text +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'JsonWriterTest class' category: #'JSON-Tests'! +JsonWriterTest class + instanceVariableNames: ''! + + diff --git a/modules/JSON/TimestampAdaptor.Class.st b/modules/JSON/TimestampAdaptor.Class.st new file mode 100644 index 00000000..2d432fd8 --- /dev/null +++ b/modules/JSON/TimestampAdaptor.Class.st @@ -0,0 +1,44 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #TimestampAdaptor category: #JSON! +DataAdaptor subclass: #TimestampAdaptor + instanceVariableNames: 'format' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!TimestampAdaptor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!TimestampAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +dataFrom: anObject + | ts | + ts := anObject isDate + ifTrue: [anObject utc] + ifFalse: [anObject asTimestamp]. + ^ts perform: format +! ! + +!TimestampAdaptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +format: aSymbol + format := aSymbol +! ! + +!TimestampAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectFrom: aString + ^Timestamp perform: (format , ':') asSymbol with: aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TimestampAdaptor class' category: #JSON! +TimestampAdaptor class + instanceVariableNames: ''! + +!TimestampAdaptor class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +iso8601 + ^self new format: #iso8601! ! + + diff --git a/modules/JSON/TypeAdaptor.Class.st b/modules/JSON/TypeAdaptor.Class.st new file mode 100644 index 00000000..34e97f7c --- /dev/null +++ b/modules/JSON/TypeAdaptor.Class.st @@ -0,0 +1,50 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:41 pm'! +!classDefinition: #TypeAdaptor category: #JSON! +DataAdaptor subclass: #TypeAdaptor + instanceVariableNames: 'classes' + classVariableNames: '' + poolDictionaries: '' + category: 'JSON'! +!TypeAdaptor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!TypeAdaptor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +classes: aCollection + classes := aCollection asDictionaryUsing: #name +! ! + +!TypeAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +dataFrom: aClass + ^(classes includes: aClass) ifTrue: [aClass name] +! ! + +!TypeAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectClasses + ^classes +! ! + +!TypeAdaptor methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:41'! +objectFrom: aString + ^classes at: aString ifAbsent: nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TypeAdaptor class' category: #JSON! +TypeAdaptor class + instanceVariableNames: ''! + +!TypeAdaptor class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +of: class + ^self new classes: {class}! ! + +!TypeAdaptor class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:41'! +restrictedTo: classes + ^self new classes: classes +! ! + + diff --git a/modules/Kernel/Abort.Class.st b/modules/Kernel/Abort.Class.st new file mode 100644 index 00000000..f70203c8 --- /dev/null +++ b/modules/Kernel/Abort.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Abort category: #Kernel! +Notification subclass: #Abort + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Abort commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Abort class' category: #Kernel! +Abort class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/ActionSequence.Class.st b/modules/Kernel/ActionSequence.Class.st new file mode 100644 index 00000000..5d2361ac --- /dev/null +++ b/modules/Kernel/ActionSequence.Class.st @@ -0,0 +1,69 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ActionSequence category: #Kernel! +Array subclass: #ActionSequence + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ActionSequence commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ActionSequence methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +& anActionSequence + ^anActionSequence notNil ifTrue: [self , anActionSequence] ifFalse: [self] +! ! + +!ActionSequence methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +&& anObject + ^anObject notNil ifTrue: [self copyWith: anObject] +! ! + +!ActionSequence methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asActionSequence + ^self +! ! + +!ActionSequence methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asArray + | array | + array := Array new: self size. + self withIndexDo: [:ai :i | array at: i put: ai]. + ^array +! ! + +!ActionSequence methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +compressed + ^self isEmpty ifFalse: [self size = 1 ifTrue: [self first] ifFalse: [self]] +! ! + +!ActionSequence methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluate + | value | + self do: [:action | value := action evaluate]. + ^value +! ! + +!ActionSequence methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWithArguments: anArray + | value | + self do: [:action | value := action evaluateWithArguments: anArray]. + ^value +! ! + +!ActionSequence methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: self class name; space. + super printOn: aStream +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ActionSequence class' category: #Kernel! +ActionSequence class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/ActiveProcess.Class.st b/modules/Kernel/ActiveProcess.Class.st new file mode 100644 index 00000000..e655964c --- /dev/null +++ b/modules/Kernel/ActiveProcess.Class.st @@ -0,0 +1,142 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ActiveProcess category: #Kernel! +Process subclass: #ActiveProcess + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ActiveProcess commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!ActiveProcess methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +backtrace + ^self reifiedCopy backtrace +! ! + +!ActiveProcess methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +beInactive + self changeClassTo: SuspendedProcess +! ! + +!ActiveProcess methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isActive + ^true +! ! + +!ActiveProcess methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +canReturnTo: homeFrame + + | method env | + homeFrame == nil ifTrue: [^false]. + homeFrame < self nativeStack bp ifTrue: [^false]. + ^true + "method := self codeAt: homeFrame. + homeFrame hasBlocks ifFalse: [^false]. + env := self methodEnvironment. + homeFrame environment == env ifTrue: [^true]. + ^homeFrame methodEnvironment == env" +! ! + +!ActiveProcess methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +drop + " + Suspend this process without saving current state (if resumed the last resumption point will be used) + " + + Processor dropActive +! ! + +!ActiveProcess methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluate: aClosure ensuring: ensuredClosure + " + Ensure is easy: when the closure is being evaluated, the only way to skip + the ensuredClosure would be through a non-local return, so we can delegate + ensure mechanism to the code that does non-local returns. + The non-local returns check for protected frames, evaluate all of them + between return source and home frames, and then does the unwinding. + The local `cursor` is needed-by and special-to the debugger, because it might + have to update the frame indices if the stack frames are changed. + " + | cursor result prev | + cursor := self nativeStack bp. + protectedFrames push: cursor. + result := aClosure value. + prev := protectedFrames pop. + prev == cursor + ifFalse: [self + _error: 'protected frame popped is not the same that was pushed originally']. + ensuredClosure value. + ^result +! ! + +!ActiveProcess methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateEnsuredUpTo: framePointer + " + Marked as atomic because the protected frames are removed on + denativization and recreated on nativization, so stepping through the + loop in this method could have undesired consequences. + Ensured closure is the argument to the evaluate:ensuring: method, which protectedFrames + point to. + " + | ensured | + #atomic. + [ + protectedFrames notEmpty and: [protectedFrames last <= framePointer]] + whileTrue: [ + ensured := self nativeStack lastArgumentOf: protectedFrames pop. + ensured value]. +! ! + +!ActiveProcess methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +launch: aMessage + exceptionHandler := nil. + aMessage evaluate. + self drop; ASSERT: false +! ! + +!ActiveProcess methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nonLocalReturn: anObject home: framePointer + " + The home frame of closure is the start of the chain (might be another + cloure). We look for the method frame, evaluate any protected blocks + in the way and return. + + We assume homeFrame is a valid index, which is guaranteed because: + - it is captured in the active process + - it is niled out when putting the process to sleep + - it is refreshed when process is reactivated + " + (self canReturnTo: framePointer) + ifFalse: [self error: 'cannot return to a frame outside current stack chunk']. + + self evaluateEnsuredUpTo: framePointer. + ^anObject _returnTo: framePointer +! ! + +!ActiveProcess methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +snapshot + " + Saves current state to allow resuming later + " + ^self nativeStack snapshot +! ! + +!ActiveProcess methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +useExceptionHandler: anExceptionHandler while: aBlock + | handler | + handler := exceptionHandler. + exceptionHandler := anExceptionHandler. + ^aBlock ensure: [exceptionHandler := handler] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ActiveProcess class' category: #Kernel! +ActiveProcess class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/Ansi.Class.st b/modules/Kernel/Ansi.Class.st new file mode 100644 index 00000000..1afa0f34 --- /dev/null +++ b/modules/Kernel/Ansi.Class.st @@ -0,0 +1,85 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Ansi category: #Kernel! +Unicode subclass: #Ansi + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Ansi commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Ansi methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFrom: aStream + ^self decodeInteger: aStream nextByte +! ! + +!Ansi methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeInteger: anInteger + | code | + anInteger < 128 ifTrue: [^anInteger]. + 159 < anInteger ifTrue: [^anInteger]. + code := Character ansiTable at: anInteger - 127. + ^code = 0 ifTrue: [anInteger] ifFalse: [code] +! ! + +!Ansi methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aCharacter on: aStream + | value index | + value := aCharacter asInteger. + ((value between: 128 and: 159) or: [255 < value]) ifTrue: [ + index := Character ansiTable indexOf: value. + value := index = 0 ifTrue: [$? asInteger] ifFalse: [index + 127]]. + aStream nextPut: value +! ! + +!Ansi methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encodeInteger: anInteger + | index | + anInteger < 256 ifTrue: [^anInteger]. + index := Character ansiTable indexOf: anInteger. + ^index = 0 ifTrue: [$? asInteger] ifFalse: [index + 127] +! ! + +!Ansi methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +parameterFrom: aString + | n param | + n := aString size. + param := ByteArray new: n + 1. + 1 to: n do: [:i | | cp byte | + cp := aString codeAt: i. + byte := self encodeInteger: cp. + param at: i put: byte]. + param at: n + 1 put: 0. + ^param +! ! + +!Ansi methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reduce: aString + | bytes | + bytes := self encode: aString. + ^String fromBytes: bytes +! ! + +!Ansi methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeOfCharacter: aCharacter + ^1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Ansi class' category: #Kernel! +Ansi class + instanceVariableNames: ''! + +!Ansi class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isAnsi: anInteger + anInteger < 128 ifTrue: [^true]. + 255 < anInteger ifTrue: [^false]. + ^159 < anInteger +! ! + + diff --git a/modules/Kernel/ArithmeticError.Class.st b/modules/Kernel/ArithmeticError.Class.st new file mode 100644 index 00000000..870caaf9 --- /dev/null +++ b/modules/Kernel/ArithmeticError.Class.st @@ -0,0 +1,104 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ArithmeticError category: #Kernel! +Error subclass: #ArithmeticError + instanceVariableNames: 'operation type' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ArithmeticError commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ArithmeticError methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +getDescription + | string | + string := self typeDescription. + operation notNil + ifTrue: [string := string , ' in ''' , operation , ''' operation']. + ^string +! ! + +!ArithmeticError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +operation: aSymbol + operation := aSymbol +! ! + +!ArithmeticError methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: self class name; space. + type notNil ifTrue: [type printOn: aStream] +! ! + +!ArithmeticError methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalCoprocessorMissing + ^self type: #coprocessor; signal +! ! + +!ArithmeticError methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalDenormalized + ^self type: #denormalized; signal +! ! + +!ArithmeticError methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalInexactOperation + ^self type: #inexact; signal +! ! + +!ArithmeticError methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalInvalidOperation + ^self type: #invalid; signal +! ! + +!ArithmeticError methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalOverflow + ^self type: #overflow; signal +! ! + +!ArithmeticError methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalUndefined + ^self type: #undefined; signal +! ! + +!ArithmeticError methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalUnderflow + ^FloatUnderflow signal +! ! + +!ArithmeticError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +type + ^type +! ! + +!ArithmeticError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +type: aSymbol + type := aSymbol. + description := self getDescription +! ! + +!ArithmeticError methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +typeDescription + type == #overflow ifTrue: [^'Floating Point overflow exception']. + type == #underflow ifTrue: [^'Floating Point underflow exception']. + type == #denormalized ifTrue: [^'Floating Point denormalized operand']. + type == #invalid ifTrue: [^'Floating Point invalid operation exception']. + type == #undefined ifTrue: [^'Floating Point undefined exception']. + type == #inexact ifTrue: [^'Floating Point inexact result']. + type == #coprocessor ifTrue: [^'Math coprocessor missing']. + ^type printString , ' invalid type symbol' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ArithmeticError class' category: #Kernel! +ArithmeticError class + instanceVariableNames: ''! + +!ArithmeticError class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aSymbol + ^self new operation: aSymbol +! ! + + diff --git a/modules/Kernel/Array.Class.st b/modules/Kernel/Array.Class.st new file mode 100644 index 00000000..4be34baf --- /dev/null +++ b/modules/Kernel/Array.Class.st @@ -0,0 +1,54 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Array category: #Kernel! +ArrayedCollection subclass: #Array + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Array commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Array methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asArray + ^self +! ! + +!Array methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asByteArray + ^ByteArray withAll: self +! ! + +!Array methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBePrintedAsLiteral + ^Recursion + checkOn: self + while: [self conform: [:each | each canBePrintedAsLiteral]] + onSignal: [false] +! ! + +!Array methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +crash + | t | + t := 1. + self do: [:each | | n | + n := self size + each + t. + (1 to: n) do: [:i | i]]. + ^self size +! ! + +!Array methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isArray + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Array class' category: #Kernel! +Array class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/ArrayedCollection.Class.st b/modules/Kernel/ArrayedCollection.Class.st new file mode 100644 index 00000000..98530548 --- /dev/null +++ b/modules/Kernel/ArrayedCollection.Class.st @@ -0,0 +1,407 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ArrayedCollection category: #Kernel! +SequenceableCollection subclass: #ArrayedCollection + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ArrayedCollection commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ArrayedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject + ^self shouldNotImplement +! ! + +!ArrayedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: aBlock + | array size | + size := self size. + array := self species new: size. + 1 + to: size + do: [:index | array at: index put: (aBlock evaluateWith: (self at: index))]. + ^array +! ! + +!ArrayedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: collectBlock thenSelect: selectBlock + | array size | + array := OrderedCollection new: self size. + self do: [:x | | fx | + fx := collectBlock evaluateWith: x. + (selectBlock evaluateWith: fx) ifTrue: [array add: fx]]. + size := array size. + ^(self species new: size) replaceFrom: 1 to: size with: array +! ! + +!ArrayedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +concurrentCollect: aBlock + | answer size token | + size := self size. + token := Object new. + answer := self species new: size. + answer atAllPut: token. + 1 + to: size + do: [:index | [| x y | + x := self at: index. + y := aBlock evaluateWith: x. + answer at: index put: y] forkThread launch]. + [answer includes: token] whileTrue: []. + ^answer +! ! + +!ArrayedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyReplaceFrom: start to: stop with: aCollection + | copy n size | + n := aCollection size. + size := self size + n - (stop - start + 1). + copy := self species new: size. + ^copy + replaceFrom: 1 to: start - 1 with: self startingAt: 1; + replaceFrom: start to: start + n - 1 with: aCollection; + replaceFrom: start + n to: size with: self startingAt: stop + 1 +! ! + +!ArrayedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + ^self objectDeepCopy +! ! + +!ByteArray methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +largeAtOffset: offset + | integer lo hi | + (self at: offset + 8) >= 16r80 ifTrue: [ + integer := 0. + offset + 8 + to: offset + 1 + by: -1 + do: [:i | integer := (integer bitShift: 8) + ((self at: i) bitXor: 16rFF)]. + ^(integer + 1) negated]. + lo := self uLongAtOffset: 0. + hi := self uLongAtOffset: 4. + ^(hi bitShift: 32) + lo +! ! + +!ByteArray methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +longAtOffset: offset + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 3 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self longAtValidOffset: offset +! ! + +!ByteArray methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +longAtOffset: offset put: anInteger + | ulong | + ulong := anInteger < 0 + ifTrue: [16r100000000 + anInteger] + ifFalse: [anInteger]. + self uLongAtOffset: offset put: ulong +! ! + +!ArrayedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +longAtValidOffset: offset + | lo hi sign | + lo := self uShortAtValidOffset: offset. + hi := self uShortAtValidOffset: offset + 2. + sign := hi bitAnd: 16r8000. + hi := hi - (sign * 2). + ^hi * 16r10000 + lo +! ! + +!ArrayedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +pointerAtOffset: offset + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 7 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uLargeAtValidOffset: offset +! ! + +!ArrayedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +pointerAtOffset: offset put: anInteger + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 7 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uLargeAtValidOffset: offset put: anInteger +! ! + +!ArrayedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: anObject ifAbsent: aBlock + ^self shouldNotImplement +! ! + +!ArrayedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +reversed + | limit result | + limit := self size + 1. + result := self species new: limit - 1. + 1 to: limit - 1 do: [:i | result at: i put: (self at: limit - i)]. + ^result +! ! + +!ArrayedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: aBlock + | size selected | + size := self size. + selected := OrderedCollection new: size. + 1 to: size do: [:i | | element | + element := self at: i. + (aBlock evaluateWith: element) ifTrue: [selected add: element]]. + size := selected size. + ^(self species new: size) replaceFrom: 1 to: size with: selected +! ! + +!ArrayedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: selectBlock thenCollect: collectBlock + | size selected | + size := self size. + selected := OrderedCollection new: size. + 1 to: size do: [:i | | element | + element := self at: i. + (selectBlock evaluateWith: element) + ifTrue: [selected add: (collectBlock evaluateWith: element)]]. + size := selected size. + ^(self species new: size) replaceFrom: 1 to: size with: selected +! ! + +!ByteArray methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +shortAtOffset: offset + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 2 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self shortAtValidOffset: offset +! ! + +!ArrayedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +shortAtValidOffset: offset + | lo hi sign | + lo := self byteAtValid: offset + 1. + hi := self byteAtValid: offset + 2. + sign := hi bitAnd: 16r80. + hi := hi - (sign * 2). + ^hi * 16r100 + lo +! ! + +!ArrayedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self primitiveSize +! ! + +!ArrayedCollection methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + | size index firstTime | + Recursion checkOn: self while: [ + self literalString ifNotNil: [:s | + aStream nextPutAll: s. + ^self]. + size := self size. + size <= 7 + ifTrue: [ + size = 0 ifTrue: [aStream nextPutAll: '#()'] ifFalse: [ + aStream nextPutAll: '('; nextPutAll: self class name. + self do: [:item | + aStream nextPutAll: ' with: '. + item storeOn: aStream]. + aStream nextPut: $)]] + ifFalse: [ + aStream + nextPutAll: '(('; + nextPutAll: self class name; + nextPutAll: ' new: '. + size printOn: aStream. + aStream nextPut: $). + index := 1. + firstTime := true. + [index <= size] whileTrue: [ + firstTime ifFalse: [aStream nextPut: $;]. + firstTime := false. + aStream nextPutAll: ' at: '. + index printOn: aStream. + aStream nextPutAll: ' put: '. + (self at: index) storeOn: aStream. + index := index + 1]. + firstTime ifFalse: [aStream nextPutAll: '; yourself']. + aStream nextPut: $)]] +! ! + +!ArrayedCollection methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLargeAtOffset: offset + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 7 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uLargeAtValidOffset: offset +! ! + +!ArrayedCollection methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLargeAtOffset: offset put: anInteger + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 7 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uLargeAtValidOffset: offset put: anInteger +! ! + +!ArrayedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLargeAtValidOffset: offset + ^(self _uLargeAtOffset: offset) + ifNil: [self _uLargeAtOffset: offset into: (LargePositiveInteger new: 8)] +! ! + +!ArrayedCollection methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLargeAtValidOffset: offset put: anInteger + anInteger size > 8 ifTrue: [self error: 'does not fit in 64 bits']. + self _uLargeAtOffset: offset put: anInteger. + ^anInteger +! ! + +!ArrayedCollection methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLongAtOffset: offset + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 3 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uLongAtValidOffset: offset +! ! + +!ArrayedCollection methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLongAtOffset: offset put: anInteger + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 3 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self _uLongAtValidOffset: offset put: anInteger +! ! + +!ArrayedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLongAtValidOffset: offset + ^(self _uLongAtOffset: offset) + ifNil: [self _uLongAtOffset: offset into: (LargePositiveInteger new: 4)] +! ! + +!ArrayedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLongAtValidOffset: offset put: anInteger + anInteger size > 4 ifTrue: [self error: 'does not fit in 32 bits']. + self _uLongAtOffset: offset put: anInteger. + ^anInteger +! ! + +!ArrayedCollection methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +uShortAtOffset: offset + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 1 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uShortAtValidOffset: offset +! ! + +!ArrayedCollection methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +uShortAtOffset: offset put: anInteger + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 1 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uShortAtValidOffset: offset put: anInteger +! ! + +!ArrayedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +uShortAtValidOffset: offset + ^(self byteAtValid: offset + 2) * 16r100 + (self byteAtValid: offset + 1) +! ! + +!ArrayedCollection methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +uShortAtValidOffset: offset put: anInteger + anInteger size > 2 ifTrue: [self error: 'does not fit in 16 bits']. + self _uShortAtOffset: offset put: anInteger. + ^anInteger +! ! + +!ArrayedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +validShortAtValidOffset: offset put: anInteger + | hi lo | + hi := anInteger bitShift: -8. + lo := anInteger bitAnd: 16rFF. + self + _byteAt: offset + 1 put: lo; + _byteAt: offset + 2 put: hi. + ^anInteger +! ! + +!ArrayedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withIndexCollect: aBlock + | answer size | + size := self size. + answer := self class new: size. + 1 to: size do: [:index | + answer at: index put: (aBlock value: (self at: index) value: index)]. + ^answer +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ArrayedCollection class' category: #Kernel! +ArrayedCollection class + instanceVariableNames: ''! + +!ArrayedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: anObject + | array | + array := self new: 1. + array at: 1 put: anObject. + ^array +! ! + +!ArrayedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: firstObject with: secondObject + | array | + array := self new: 2. + array + at: 1 put: firstObject; + at: 2 put: secondObject. + ^array +! ! + +!ArrayedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: firstObject with: secondObject with: thirdObject + | array | + array := self new: 3. + array + at: 1 put: firstObject; + at: 2 put: secondObject; + at: 3 put: thirdObject. + ^array +! ! + +!ArrayedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: firstObject with: secondObject with: thirdObject with: fourthObject + | array | + array := self new: 4. + array + at: 1 put: firstObject; + at: 2 put: secondObject; + at: 3 put: thirdObject; + at: 4 put: fourthObject. + ^array +! ! + +!ArrayedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: anObject withAll: aCollection + | array | + array := self new: aCollection size + 1. + array + at: 1 put: anObject; + replaceFrom: 2 to: array size with: aCollection. + ^array +! ! + +!ArrayedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: aCollection with: anObject + | instance | + instance := self new: aCollection size + 1. + instance + replaceFrom: 1 to: instance size - 1 with: aCollection; + at: instance size put: anObject. + ^instance +! ! + + diff --git a/modules/Kernel/AssertionFailure.Class.st b/modules/Kernel/AssertionFailure.Class.st new file mode 100644 index 00000000..7c36faa6 --- /dev/null +++ b/modules/Kernel/AssertionFailure.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #AssertionFailure category: #Kernel! +Halt subclass: #AssertionFailure + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!AssertionFailure commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!AssertionFailure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultDescription + ^'assertion failed' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'AssertionFailure class' category: #Kernel! +AssertionFailure class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/Association.Class.st b/modules/Kernel/Association.Class.st new file mode 100644 index 00000000..1f710738 --- /dev/null +++ b/modules/Kernel/Association.Class.st @@ -0,0 +1,91 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Association category: #Kernel! +Object subclass: #Association + instanceVariableNames: 'key value' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Association commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Association methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += anAssociation + ^anAssociation isAssociation + and: [key = anAssociation key] + and: [value = anAssociation value] +! ! + +!Association methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBePrintedAsLiteral + ^key canBePrintedAsLiteral and: [value canBePrintedAsLiteral] +! ! + +!Association methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^key hash +! ! + +!Association methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isAssociation + ^true +! ! + +!Association methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +key + ^key +! ! + +!Association methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +key: anObject + key := anObject +! ! + +!Association methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + key printOn: aStream. + aStream nextPutAll: ' -> '. + value printOn: aStream +! ! + +!Association methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + aStream nextPut: $(. + key storeOn: aStream. + aStream nextPutAll: ' -> '. + value storeOn: aStream. + aStream nextPut: $) +! ! + +!Association methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +value + ^value +! ! + +!Association methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: anObject + value := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Association class' category: #Kernel! +Association class + instanceVariableNames: ''! + +!Association class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +key: anObject + ^self new key: anObject +! ! + +!Association class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +key: key value: value + | assoc | + assoc := self key: key. + ^assoc value: value +! ! + + diff --git a/modules/Kernel/Bag.Class.st b/modules/Kernel/Bag.Class.st new file mode 100644 index 00000000..0aa0ba02 --- /dev/null +++ b/modules/Kernel/Bag.Class.st @@ -0,0 +1,194 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Bag category: #Kernel! +Collection subclass: #Bag + instanceVariableNames: 'contents' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Bag commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Bag methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aBag + (aBag isKindOf: Bag) ifFalse: [^false]. + self size = aBag size ifFalse: [^false]. + contents associationsDo: [:assoc | | count | + count := aBag occurrencesOf: assoc key. + assoc value = count ifFalse: [^false]]. + ^true +! ! + +!Bag methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject + contents at: anObject sum: 1. + ^anObject +! ! + +!Bag methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject withOccurrences: anInteger + contents at: anObject sum: anInteger. + ^anObject +! ! + +!Bag methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +anyone + contents keysDo: [:k | ^k]. + ^nil +! ! + +!Bag methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asBag + ^self +! ! + +!Bag methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asIdentitySet + ^contents keys asIdentitySet +! ! + +!Bag methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asSet + ^contents keys +! ! + +!Bag methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anObject + ^self errorNotKeyed +! ! + +!Bag methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: anObject + self errorNotKeyed +! ! + +!Bag methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +contentsClass + ^Dictionary +! ! + +!Bag methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultPolicy + ^contents defaultPolicy +! ! + +!Bag methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + contents + keysAndValuesDo: [:key :value | value timesRepeat: [aBlock value: key]] +! ! + +!Bag methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +doWithOccurrences: aBlock + contents keysAndValuesDo: [:k :v | aBlock value: k value: v] +! ! + +!Bag methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +elements + ^contents +! ! + +!Bag methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +frequencies + ^contents +! ! + +!Bag methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +includes: anObject + ^contents includesKey: anObject +! ! + +!Bag methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + contents := self contentsClass new +! ! + +!Bag methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize: anInteger + contents := self contentsClass new: anInteger +! ! + +!Bag methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmpty + ^contents isEmpty +! ! + +!Bag methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +keysAndValuesDo: aBlock + contents keysAndValuesDo: [:k :v | aBlock value: k value: v] +! ! + +!Bag methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +occurrencesOf: anObject + ^contents at: anObject ifAbsent: 0 +! ! + +!Bag methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +postCopy + super postCopy. + contents := contents copy +! ! + +!Bag methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: anObject ifAbsent: aBlock + | count | + count := contents at: anObject sum: -1. + count > 0 ifTrue: [^anObject]. + contents removeKey: anObject. + count = -1 ifTrue: [^aBlock value]. + ^anObject +! ! + +!Bag methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAll + contents removeAll +! ! + +!Bag methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + | tally | + tally := 0. + contents do: [:count | tally := tally + count]. + ^tally +! ! + +!Bag methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +sortedCounts + | counts | + counts := Array + streamContents: [:strm | contents + keysAndValuesDo: [:k :v | strm nextPut: v -> k]]. + ^counts sortBy: [:x :y | x key >= y key] +! ! + +!Bag methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +usePolicy: aHashTablePolicy + ^contents usePolicy: aHashTablePolicy +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Bag class' category: #Kernel! +Bag class + instanceVariableNames: ''! + +!Bag class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self basicNew initialize: anInteger +! ! + +!Bag class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: aCollection + | bag | + bag := self new: aCollection size. + bag addAll: aCollection. + ^bag +! ! + + +Bag initialize! + diff --git a/modules/Kernel/BareTests/BareTestsModule.Class.st b/modules/Kernel/BareTests/BareTestsModule.Class.st new file mode 100644 index 00000000..5e13cdaa --- /dev/null +++ b/modules/Kernel/BareTests/BareTestsModule.Class.st @@ -0,0 +1,466 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #BareTestsModule category: #'Powerlang-Core'! +Module subclass: #BareTestsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core'! +!BareTestsModule commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!BareTestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +imports + ^{ + #Kernel -> #(HashTable) + } +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test001SendYourself + ^true yourself +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test010SendEqualsEquals + ^5 == 5 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test020SendPlus + ^3 + 4 == 7 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test025SendQuotient + ^20 // 5 == 4 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test0 + ^(false ifTrue: [1]) == nil +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test031SendIfFalseToTrue + ^(true ifFalse: [1]) == nil +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test032SendIfTrueToTrue + ^(true ifTrue: [5]) == 5 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test040SendIfNotNil + ^5 ifNotNil: [true] +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test041SendIfNotNilWithArgs + ^true ifNotNil: [:a | a isString ifFalse: [a]] +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test042SendIfNotNilWithNonEvaluableArg + ^true ifNotNil: [:a | a isString ifFalse: a] +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test030UseTemporary + | temp | + temp := true. + ^temp +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test031UseManyTemporaries + | temp1 temp2 temp3 | + temp2 := 3. + temp1 := 4. + temp3 := temp1 + temp2. + ^temp3 == 7 +! ! + +!BareTestsModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +useArg: foo + ^foo + 1 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test040UseArg + ^(self useArg: 3) == 4 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +useArgsToDivide: anInteger by: anotherInteger + ^anInteger // anotherInteger +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test041UseArgsInOrder + ^(self useArgsToDivide: 20 by: 5) == 4 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test042IntegerOperations + | a b low14a high14a low14b high14b res | + a := 0xCB3009. + b := 0x19660D. + low14a := a bitAnd: 16r3FFF. + low14a == 0x3009 ifFalse: [^1]. + + high14a := a bitShift: -14. + high14a == 0x32C ifFalse: [^high14a]. + + low14b := b bitAnd: 16r3FFF. + low14b == 0x260D ifFalse: [^3]. + high14b := b bitShift: -14. + high14b == 0x65 ifFalse: [^4]. + res := 16r4000 * (low14b * high14a + (high14b * low14a) bitAnd: 16r3FFF) + + (low14b * low14a) + bitAnd: 16rFFFFFFF. + ^res == 0x560675 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test043HashMultiply + | hash xor | + hash := 8. + hash := hash hashMultiply: 0x19660D. + hash == 0xCB3068 ifFalse: [^1]. + hash := hash bitXor: 97. + hash == 0xCB3009 ifFalse: [^2]. + hash := hash hashMultiply: 0x19660D. + hash == 0x560675 ifFalse: [^3]. + hash := hash bitXor: 115. + hash == 0x560606 ifFalse: [^4]. + ^true + +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test049HashSymbol + ^true "^#asSymbol stringHash == 174482412" +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test100EvaluateClosure + ^[true] value +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test100SendWhileTrue + | a | + a := true. + [a] whileTrue: [a := false]. + ^a not +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test110SendToDo + | a | + a := 0. + 3 to: 4 do: [:i | a := a + i]. + ^a = 7 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test120SendTimesRepeat + | a | + a := 0. + 5 timesRepeat: [a := a + 1]. + ^a = 5 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test121SendTimesRepeatInsideBlock + | a b c d e | + a := 0. + [10 timesRepeat: [a := a + 1]] value. + ^a = 10 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test130EvaluateClosureWithArgs + | result | + result := [:a :b | a + b] value: 3 value: 4. + ^result = 7 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test131EvaluateClosureWithArgsAndTemps + | result | + result := [:a :b | | t | t := a + b. t] value: 3 value: 4. + ^result = 7 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test132EvaluateClosureWithArgsAndMethodTemps + | result t | + result := [:a :b | t := a + b. t] value: 3 value: 4. + ^result = 7 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test133EvaluateClosureWithArgsAndMultipleTemps + | s result | + s := 3. + result := [:a | | t | + t := a. + t := t + s. + t] value: 4. + ^result = 7 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test140EvaluateClosureNonLocalReturn + | s | + [s := 3. ^true] value. + s := 4. + ^false +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test150EvaluateNestedClosure + ^[ [ true ] value ] value +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test151EvaluateNestedClosureWithArgs + | result | + result := [:a | [:b | a + b ] value: 4 ] value: 3. + ^result = 7 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test152EvaluateNestedClosureWithTemps + | a result | + a := 2. + result := [ | b | + b := 3. + [ | c | + c := 4. + a + b + c ] value] value. + ^result = 9 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test153EvaluateInlinedClosureInClosureWithMethodTemps + | a result | + a := 3. + [ true ifTrue: [ result := a + 4 ] ] value. + ^result = 7 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test160ConcatenateStrings + ^'ABC', 'DE' = 'ABCDE' +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test161CreateDictionary + | t | + t := 'Character' asSymbol. + "(Kernel namespace at: 'Dictionary' asSymbol) new." + ^true +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test162AddAssociationToDictionary + "| dict | + dict := (Kernel namespace at: 'Dictionary' asSymbol) new. + dict add: #yourself -> true. + ^dict at: #yourself" + ^true +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test170SmallIntegerPrintString + | result | + result := 16r1000 printString. + ^result = '4096' +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test171LargeIntegerPrintString + | result | + result := 4611686018427387903 printString. + ^result = '4611686018427387903' +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test172NegativeIntegerPrintString + | result | + result := -4. + ^result printString = '-4' +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test180FallbackToLargeNegativeInteger + | result | + result := (16r100000000 * -16r100000000) printString. + ^result = '-18446744073709551616' +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test182BitShiftRightFullWidth + "SmallInteger>>bitShift: with negative shift >= word width must yield 0 + (or -1 for negative receivers), not undefined behaviour from C++." + ^(1 bitShift: -64) == 0 + and: [(1 bitShift: -100) == 0 + and: [(-1 bitShift: -64) == -1 + and: [(16rFFFFFFFFFFFFFFFF + 1) = 16r10000000000000000]]] +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test183FloatTimesTwoPower + ^(1.0 timesTwoPower: 0) = 1.0 + and: [(1.0 timesTwoPower: 10) = 1024.0 + and: [(1.0 timesTwoPower: -10) = (1.0 / 1024.0) + and: [(1.0 timesTwoPower: -107) > 0.0 + and: [(1 / 10000000000000000) asFloat > 0.0]]]] +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test181FallbackToLargePositiveInteger + | result | + result := 1. + 18 timesRepeat: [result := result * 10]. + ^result printString = '1000000000000000000' +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test200BitAndSmallIntegers + ^(16rAAAA bitAnd: 16r00FF) == 16r00AA +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test201BitAndSmallIntWithLargeInt + ^(16rAA bitAnd: 16rFFFFFFFFFFFFFFFF) == 16rAA +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test202BitAndLargeIntWithSmallInt + ^(16rFFFFFFFFFFFFFFFF bitAnd: 16rAA) == 16rAA +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test210BitOrSmallIntegers + ^(16rAA00 bitOr: 16r00AA) == 16rAAAA +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test211BitOrSmallIntWithLargeInt + ^(16rAA bitOr: 16rAA00000000) = 16rAA000000AA +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test212BitOrLargeIntWithSmallInt + ^(16rAA00000000 bitOr: 16rAA) = 16rAA000000AA +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test220BitXorSmallIntegers + ^(16rAAAA bitXor: 16r00FF) == 16rAA55 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test221BitXorSmallIntWithLargeInt + ^(16rAA bitXor: 16rAA000000AA) = 16rAA00000000 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test222BitXorLargeIntWithSmallInt + ^(16rAA000000AA bitXor: 16rAA) = 16rAA00000000 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test230BitShiftLeftOverflow + ^(1 bitShift: 64) = 16r10000000000000000 +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test231BitShiftRightNegativeArg + ^(16rAA00 bitShift: -8) == 16rAA +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test232BitShiftRightSelector + ^(16rAA00 bitShiftRight: 8) == 16rAA +! ! + +!BareTestsModule methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:38'! +test240HashTablePrimeForReturnsNextGoodPrime + ^(HashTable primeFor: 300) == 359 +! ! + +!BareTestsModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:38'! +runTest: selector + | result | + result := self perform: selector. + result == true + ifTrue: [Kernel log: ' PASS: ', selector, ' +'] + ifFalse: [Kernel log: ' FAIL: ', selector, ' returned: ', result printString, ' +']. + ^result == true +! ! + +!BareTestsModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:38'! +main: anArray + | passed failed tests | + Kernel log: 'Running Kernel.BareTests... +'. + passed := 0. failed := 0. + tests := #( + test001SendYourself test010SendEqualsEquals test020SendPlus + test025SendQuotient test0 + test030UseTemporary test031SendIfFalseToTrue test031UseManyTemporaries + test032SendIfTrueToTrue + test040SendIfNotNil test040UseArg + test041SendIfNotNilWithArgs test041UseArgsInOrder + test042SendIfNotNilWithNonEvaluableArg test042IntegerOperations + test043HashMultiply test049HashSymbol + test100EvaluateClosure test100SendWhileTrue + test110SendToDo test120SendTimesRepeat test121SendTimesRepeatInsideBlock + test130EvaluateClosureWithArgs test131EvaluateClosureWithArgsAndTemps + test132EvaluateClosureWithArgsAndMethodTemps + test133EvaluateClosureWithArgsAndMultipleTemps + test140EvaluateClosureNonLocalReturn + test150EvaluateNestedClosure test151EvaluateNestedClosureWithArgs + test152EvaluateNestedClosureWithTemps + test153EvaluateInlinedClosureInClosureWithMethodTemps + test160ConcatenateStrings test161CreateDictionary + test162AddAssociationToDictionary + test170SmallIntegerPrintString test171LargeIntegerPrintString + test172NegativeIntegerPrintString + test180FallbackToLargeNegativeInteger test181FallbackToLargePositiveInteger + test182BitShiftRightFullWidth test183FloatTimesTwoPower + test200BitAndSmallIntegers test201BitAndSmallIntWithLargeInt + test202BitAndLargeIntWithSmallInt + test210BitOrSmallIntegers test211BitOrSmallIntWithLargeInt + test212BitOrLargeIntWithSmallInt + test220BitXorSmallIntegers test221BitXorSmallIntWithLargeInt + test222BitXorLargeIntWithSmallInt + test230BitShiftLeftOverflow test231BitShiftRightNegativeArg + test232BitShiftRightSelector + test240HashTablePrimeForReturnsNextGoodPrime). + tests do: [:sel | + (self runTest: sel) + ifTrue: [passed := passed + 1] + ifFalse: [failed := failed + 1]]. + Kernel log: tests size printString, ' run, ', passed printString, ' passed, ', failed printString, ' failed +' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BareTestsModule class' category: #'Powerlang-Core'! +BareTestsModule class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/BeeTranscript.Class.st b/modules/Kernel/BeeTranscript.Class.st new file mode 100644 index 00000000..cad11960 --- /dev/null +++ b/modules/Kernel/BeeTranscript.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #BeeTranscript category: #Kernel! +Object subclass: #BeeTranscript + instanceVariableNames: 'out' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!BeeTranscript commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!BeeTranscript methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:27:38'! +close +! ! + +!BeeTranscript methodsFor: 'output' stamp: 'KenD 28/Jun/2026 13:27:38'! +cr + self output: String cr +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BeeTranscript class' category: #Kernel! +BeeTranscript class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/Behavior.Class.st b/modules/Kernel/Behavior.Class.st new file mode 100644 index 00000000..0a01a2f6 --- /dev/null +++ b/modules/Kernel/Behavior.Class.st @@ -0,0 +1,175 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Behavior category: #Kernel! +Object subclass: #Behavior + instanceVariableNames: 'class methods next' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Behavior commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Behavior methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aBehavior + self class = aBehavior class ifFalse: [^false]. + class = aBehavior classBinding ifFalse: [^false]. + methods = aBehavior methods ifFalse: [^false]. + next = aBehavior next ifFalse: [^false]. + ^true +! ! + +!Behavior methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asArray + ^(OrderedCollection from: self iterator: #do:) asArray +! ! + +!Behavior methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classBinding + ^class +! ! + +!Behavior methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classBinding: aSpecies + class := aSpecies +! ! + +!Behavior methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyWithout: behavior + | b | + methods == behavior + ifTrue: [^next isNil ifTrue: [self class new] ifFalse: [next]]. + next isNil ifTrue: [^self]. + b := next == behavior + ifTrue: [next next] + ifFalse: [next copyWithout: behavior]. + ^self copy next: b +! ! + +!Behavior methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + aBlock evaluateWith: methods. + next notNil ifTrue: [next do: aBlock] +! ! + +!Behavior methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +enhancedWith: aMethodDictionary + ^self class with: aMethodDictionary withAll: self +! ! + +!Behavior methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +findMethodFor: aSymbol + self do: [:md | | cm | + cm := md at: aSymbol ifAbsent: nil. + cm notNil ifTrue: [^cm]]. + ^nil +! ! + +!Behavior methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +findMethodFor: aSymbol in: aClass + self do: [:md | | cm | + cm := md at: aSymbol ifAbsent: nil. + (cm notNil and: [cm classBinding == aClass]) ifTrue: [^cm]]. + ^nil +! ! + +!Behavior methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromClass: aClass + class := aClass. + methods := aClass instanceBehavior methods. + next := aClass superclass ifNotNil: [:sc | sc instanceBehavior]. + next notNil ifTrue: [self ASSERT: next == self] +! ! + +!Behavior methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^methods hashWith: next +! ! + +!Behavior methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isInstanceBehavior + ^class instanceBehavior !!== self +! ! + +!Behavior methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +implements: aSymbol + | method | + method := self findMethodFor: aSymbol. + ^method !!== nil +! ! + +!Behavior methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +includes: behavior + self == behavior ifTrue: [^true]. + methods == behavior ifTrue: [^true]. + ^next notNil and: [next includes: behavior] +! ! + +!Behavior methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instanceBehavior + ^self isInstanceBehavior ifTrue: [methods] +! ! + +!Behavior methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +methods + ^methods +! ! + +!Behavior methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +methods: aMethodDictionary + methods := aMethodDictionary +! ! + +!Behavior methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +next + ^next +! ! + +!Behavior methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +next: aBehavior + next := aBehavior +! ! + +!Behavior methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replace: aBehavior with: newBehavior + next == aBehavior + ifTrue: [next := newBehavior] + ifFalse: [next notNil ifTrue: [next replace: aBehavior with: newBehavior]] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Behavior class' category: #Kernel! +Behavior class + instanceVariableNames: ''! + +!Behavior class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromClass: aClass + ^self new fromClass: aClass +! ! + +!Behavior class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^super new basicHash; yourself +! ! + +!Behavior class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: md + ^self new methods: md +! ! + +!Behavior class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: md1 with: md2 + ^self new + methods: md1; + next: (self with: md2) +! ! + +!Behavior class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: md withAll: behavior + ^self new methods: md; next: behavior +! ! + + diff --git a/modules/Kernel/Boolean.Class.st b/modules/Kernel/Boolean.Class.st new file mode 100644 index 00000000..a29f6254 --- /dev/null +++ b/modules/Kernel/Boolean.Class.st @@ -0,0 +1,76 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Boolean category: #Kernel! +Object subclass: #Boolean + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Boolean commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Boolean methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asBoolean + ^self +! ! + +!Boolean methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBePrintedAsLiteral + ^true +! ! + +!Boolean methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + ^self +! ! + +!Boolean methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBoolean + ^true +! ! + +!Boolean methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFixedObject + ^true +! ! + +!Boolean methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +shallowCopy + ^self +! ! + +!Boolean methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + self printOn: aStream +! ! + +!Boolean methodsFor: 'flow control' stamp: 'KenD 28/Jun/2026 13:27:38'! +whileFalse: aBlock + [self] whileFalse: [aBlock value] +! ! + +!Boolean methodsFor: 'flow control' stamp: 'KenD 28/Jun/2026 13:27:38'! +whileTrue: aBlock + [self] whileTrue: [aBlock value] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Boolean class' category: #Kernel! +Boolean class + instanceVariableNames: ''! + +!Boolean class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self shouldNotImplement +! ! + +!Boolean class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self shouldNotImplement +! ! + + diff --git a/modules/Kernel/BootstrapDictionary.Class.st b/modules/Kernel/BootstrapDictionary.Class.st new file mode 100644 index 00000000..3644d6f8 --- /dev/null +++ b/modules/Kernel/BootstrapDictionary.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #BootstrapDictionary category: #Kernel! +Object subclass: #BootstrapDictionary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!BootstrapDictionary commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!BootstrapDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: key + +! ! + +!BootstrapDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: key put: value + +! ! + +!BootstrapDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +beConstantPool + +! ! + +!BootstrapDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +keys + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BootstrapDictionary class' category: #Kernel! +BootstrapDictionary class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/ByteArray.Class.st b/modules/Kernel/ByteArray.Class.st new file mode 100644 index 00000000..82e1acc7 --- /dev/null +++ b/modules/Kernel/ByteArray.Class.st @@ -0,0 +1,267 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ByteArray category: #Kernel! +ArrayedCollection subclass: #ByteArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ByteArray commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ByteArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asByteArray + ^self +! ! + +!ByteArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asParameter + ^self +! ! + +!ByteArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asString + | string n | + n := self size. + (n > 0 and: [(self at: n) = 0]) ifTrue: [n := n - 1]. + string := String new: n. + ^string replaceBytesFrom: 1 to: n with: self startingAt: 1 +! ! + +!ByteArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicPrintOn: aStream + self printOn: aStream base: 16 +! ! + +!ByteArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicPrintTextOn: rtf + self printOn: rtf base: 16 +! ! + +!ByteArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +binaryReadStream + ^self readStream +! ! + +!ByteArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBePrintedAsLiteral + ^true +! ! + +!ByteArray methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +eol + | n byte | + n := self size. + n = 0 ifTrue: [^nil]. + byte := self at: n. + byte = 13 ifTrue: [^String cr]. + byte = 10 ifTrue: [ + ^n = 1 + ifTrue: [String lf] + ifFalse: [(self at: n - 1) = 13 ifTrue: [String crlf] ifFalse: [String lf]]]. + 1 to: n - 1 do: [:i | + byte := self at: i. + byte = 13 + ifTrue: [^(self at: i + 1) = 10 ifTrue: [String crlf] ifFalse: [String cr]]. + byte = 10 ifTrue: [^String lf]]. + ^nil +! ! + +!ByteArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +goodHash + | hash | + hash := self size. + self + do: [:byte | hash := (hash * 16r19660D bitAnd: 16rFFFFFFF) bitXor: byte]. + ^hash +! ! + +!ByteArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + | hash | + hash := self size. + 1 + to: hash + do: [:i | hash := (hash hashMultiply: 16r19660D) bitXor: (self at: i)]. + ^hash +! ! + +!ByteArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +integerAt: i bytes: n + | word m | + word := 0. + m := self size - i + 1 min: n. + 1 to: m do: [:j | | byte | + i + j - 1 > self size ifFalse: [ + byte := self at: i + j - 1. + word := word + (byte bitShift: j - 1 * 8)]]. + ^word +! ! + +!ByteArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isByteArray + ^true +! ! + +!ByteArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isValid + ^true +! ! + +!ByteArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream base: anInteger + aStream nextPutAll: '#['. + self + do: [:byte | byte printOn: aStream base: anInteger paddedTo: 2] + separatedBy: [aStream space]. + aStream nextPut: $] +! ! + +!ByteArray methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceBytesUpTo: count with: aCollection + ^self replaceBytesFrom: 1 to: count with: aCollection startingAt: 1 +! ! + +!ByteArray methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFirst: count with: aCollection + ^self replaceFrom: 1 to: count with: aCollection startingAt: 1 +! ! + +!ByteArray methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop with: aCollection + stop - start + 1 <= aCollection sizeInBytes + ifFalse: [^self error: 'replacement collection has the wrong size']. + self + replaceFrom: start + to: stop + with: aCollection + startingAt: 1 +! ! + +!ByteArray methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop with: collection startingAt: position + | pos | + collection class isBytes ifTrue: [ + pos := collection isWideString + ifTrue: [collection indexAt: position] + ifFalse: [position]. + ^self replaceBytesFrom: start to: stop with: collection startingAt: pos]. + super replaceFrom: start to: stop with: collection startingAt: position +! ! + +!ByteArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +segmentFrom: index size: size + ^ByteArraySegment on: self from: index size: size +! ! + +!ByteArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^self size +! ! + +!ByteArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +smallPointerAtOffset: offset + | low high | + WordSize = 8 ifTrue: [^(self pointerAtOffset: offset) // 2]. + low := self uShortAtOffset: offset. + low := low bitShift: -1. + high := self uShortAtOffset: offset + 2. + high := high bitShift: 15. + ^high + low +! ! + +!ByteArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +smallPointerAtOffset: offset put: anInteger + | low high | + WordSize = 8 ifTrue: [^self pointerAtOffset: offset put: anInteger * 2]. + low := anInteger bitAnd: 0xFFFF. + low := low bitShift: 1. + low := low bitAnd: 0xFFFF. + self uShortAtOffset: offset put: low. + high := anInteger bitShift: -15. + self uShortAtOffset: offset + 2 put: high +! ! + +!ByteArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + self storeOn: aStream base: 16 +! ! + +!ByteArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream base: anInteger + aStream nextPutAll: '#['. + self + do: [:byte | byte printOn: aStream base: anInteger] + separatedBy: [aStream space]. + aStream nextPut: $] +! ! + +!ByteArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream base: base bytes: bytes + | limit digits width n stream end | + limit := 1 bitShift: bytes * 8. + digits := limit - 1 digitsBase: base. + width := digits size. + n := self size min: self printLimit. + stream := '' writeStream. + 1 to: n by: bytes do: [:i | | word string char | + word := self integerAt: i bytes: bytes. + i - 1 \\ 16 = 0 ifTrue: [ + stream reset. + string := i - 1 printPaddedWith: $0 to: 4 base: 16. + aStream + nextPutAll: '<16r'; + nextPutAll: string; + nextPutAll: '> ']. + string := word printPaddedWith: $0 to: width base: base. + aStream nextPutAll: string; space. + char := (word < 32 or: [(word bitShift: -18) > 255]) + ifTrue: [$.] + ifFalse: [word asCharacter]. + stream nextPut: char. + i + bytes - 1 \\ 16 = 0 + ifTrue: [aStream space; nextPutAll: stream contents; cr]]. + self size \\ 16 = 0 ifFalse: [ + end := self size + 16 truncateTo: 16. + self size + 1 + to: end + by: bytes + do: [:i | width + 1 timesRepeat: [aStream space]]. + aStream space; nextPutAll: stream contents]. + n < self size ifTrue: [aStream cr; nextPut: $…] +! ! + +!ByteArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeStringBase: base + ^self storeStringBase: base bytes: 1 +! ! + +!ByteArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeStringBase: base bytes: bytes + ^String + streamContents: [:strm | self storeOn: strm base: base bytes: bytes] +! ! + +!ByteArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf16 + ^UTF16 current decode: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ByteArray class' category: #Kernel! +ByteArray class + instanceVariableNames: ''! + +!ByteArray class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromBytes: anObject length: anInteger + | bytes | + bytes := self new: anInteger. + bytes replaceFrom: 1 to: anInteger with: anObject startingAt: 1. + ^bytes +! ! + + diff --git a/modules/Kernel/ByteArraySegment.Class.st b/modules/Kernel/ByteArraySegment.Class.st new file mode 100644 index 00000000..ebf4c7e0 --- /dev/null +++ b/modules/Kernel/ByteArraySegment.Class.st @@ -0,0 +1,248 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ByteArraySegment category: #Kernel! +ArrayedCollection subclass: #ByteArraySegment + instanceVariableNames: 'contents offset size' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ByteArraySegment commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ByteArraySegment methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! += aCollection + | index | + self == aCollection ifTrue: [^true]. + self class == aCollection class ifFalse: [^false]. + index := self size. + index !!= aCollection size ifTrue: [^false]. + [index <= 0] whileFalse: [ + (self at: index) = (aCollection at: index) ifFalse: [^false]. + index := index - 1]. + ^true +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asByteArray + ^self copyFrom: 1 to: size +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asInteger + ^self inject: 0 into: [:sum :each | (sum bitShift: 8) + each] +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asParameter + ^self asByteArray asParameter +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asString + | string n | + n := self size. + (n > 0 and: [(self at: n) = 0]) ifTrue: [n := n - 1]. + string := String new: n. + ^string replaceBytesFrom: 1 to: n with: self startingAt: 1 +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: anInteger + ^self byteAt: anInteger +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: anInteger put: byte + ^self byteAt: anInteger put: byte +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +byteAt: index + self validateIndex: index. + ^contents at: offset + index +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +byteAt: index put: byte + self validateIndex: index. + ^contents at: offset + index put: byte +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +byteAtOffset: anInteger + ^self byteAt: anInteger + 1 +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +byteAtOffset: anInteger put: byte + ^self byteAt: anInteger + 1 put: byte +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +bytesAtOffset: anInteger put: aByteArray + self + replaceFrom: anInteger + 1 + to: anInteger + aByteArray sizeInBytes + with: aByteArray + startingAt: 1 +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyFrom: start to: end + | s | + self validateIndex: start toIndex: end. + ^contents copyFrom: offset + start to: offset + end +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +endOffset + ^offset + size +! ! + +!ByteArraySegment methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hash + | hash | + hash := size. + offset + 1 + to: offset + size + do: [:i | hash := (hash hashMultiply: 16r19660D) bitXor: (contents at: i)]. + ^hash +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +longAtOffset: anInteger + self validateIndex: anInteger + 1 toIndex: anInteger + 4. + ^contents longAtOffset: offset + anInteger +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +longAtOffset: anInteger put: long + self validateIndex: anInteger + 1 toIndex: anInteger + 4. + contents longAtOffset: offset + anInteger put: long +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +offset + ^offset +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +offset: anInteger + offset := anInteger +! ! + +!ByteArraySegment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aByteArray from: start to: stop + contents := aByteArray. + offset := start - 1. + size := stop - start + 1 +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceBytesUpTo: count with: aCollection + count > size ifTrue: [self validateIndex: count]. + self replaceFrom: 1 to: count with: aCollection +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceFrom: start to: end with: another + ^self replaceFrom: start to: end with: another startingAt: 1 +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceFrom: start to: end with: another startingAt: index + self validateIndex: start toIndex: end. + ^contents + replaceFrom: offset + start + to: offset + end + with: another + startingAt: index +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +segmentFrom: index size: anInteger + ^ByteArraySegment on: self from: index size: anInteger +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +size + ^size +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +sizeInBytes + ^size +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +uLargeAtOffset: anInteger + self validateIndex: anInteger + 1 toIndex: anInteger + 8. + ^contents uLargeAtOffset: offset + anInteger +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +uLargeAtOffset: anInteger put: ularge + self validateIndex: anInteger + 1 toIndex: anInteger + 8. + ^contents uLargeAtOffset: offset + anInteger put: ularge +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +uLongAtOffset: anInteger + self validateIndex: anInteger + 1 toIndex: anInteger + 4. + ^contents uLongAtOffset: offset + anInteger +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +uLongAtOffset: anInteger put: long + self validateIndex: anInteger + 1 toIndex: anInteger + 4. + contents uLongAtOffset: offset + anInteger put: long +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +uShortAtOffset: anInteger + self validateIndex: anInteger + 1 toIndex: anInteger + 2. + ^contents uShortAtOffset: offset + anInteger +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +uShortAtOffset: anInteger put: long + self validateIndex: anInteger + 1 toIndex: anInteger + 2. + contents uShortAtOffset: offset + anInteger put: long +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +utf16 + ^UTF16 current decode: self asByteArray +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +validateIndex: index + (index between: 1 and: size) ifFalse: [self outOfBoundsIndex: index] +! ! + +!ByteArraySegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +validateIndex: start toIndex: end + 1 <= start ifFalse: [self outOfBoundsIndex: start]. + end <= size ifFalse: [self outOfBoundsIndex: end] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ByteArraySegment class' category: #Kernel! +ByteArraySegment class + instanceVariableNames: ''! + +!ByteArraySegment class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aByteArray from: start size: size + ^self on: aByteArray from: start to: start + size - 1 +! ! + +!ByteArraySegment class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aByteArray from: start to: stop + ^self new on: aByteArray from: start to: stop +! ! + + diff --git a/modules/Kernel/Character.Class.st b/modules/Kernel/Character.Class.st new file mode 100644 index 00000000..b88fc2cc --- /dev/null +++ b/modules/Kernel/Character.Class.st @@ -0,0 +1,848 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Character category: #Kernel! +Magnitude subclass: #Character + instanceVariableNames: 'value' + classVariableNames: 'ByteCharacters' + poolDictionaries: '' + category: 'Kernel'! +!Character commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Character methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aMagnitude + | subtraction | + subtraction := aMagnitude isCharacter + ifTrue: [aMagnitude asInteger] + ifFalse: [aMagnitude]. + ^value - subtraction +! ! + +!Character methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +, characterOrString + ^self asString , characterOrString asString +! ! + +!Character methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aMagnitude + | addend | + addend := aMagnitude isCharacter + ifTrue: [aMagnitude asInteger] + ifFalse: [aMagnitude]. + ^self class value: value + addend +! ! + +!Character methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aCharacter + | anotherValue | + anotherValue := aCharacter codePoint. + (value < 256 and: [anotherValue < 256]) ifTrue: [^(Latin1Order at: value) < (Latin1Order at: anotherValue)]. + ^UnicodeLibrary isCodePoint: value lessThan: anotherValue +! ! + +!Character methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<~ aMagnitude + ^self <= aMagnitude +! ! + +!Character methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aCharacter + | anotherValue | + anotherValue := aCharacter codePoint. + (value < 256 and: [anotherValue < 256]) ifTrue: [^(Latin1Order at: value) <= (Latin1Order at: anotherValue)]. + ^UnicodeLibrary isCodePoint: value lessThanOrEqualTo: anotherValue +! ! + +!Character methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aCharacter + ^self class == aCharacter class and: [value = aCharacter codePoint] +! ! + +!Character methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aCharacter + | anotherValue | + anotherValue := aCharacter codePoint. + (value < 256 and: [anotherValue < 256]) ifTrue: [^(Latin1Order at: value) > (Latin1Order at: anotherValue)]. + ^UnicodeLibrary isCodePoint: value greaterThan: anotherValue +! ! + +!Character methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aCharacter + | anotherValue | + anotherValue := aCharacter codePoint. + (value < 256 and: [anotherValue < 256]) ifTrue: [^(Latin1Order at: value) >= (Latin1Order at: anotherValue)]. + ^UnicodeLibrary isCodePoint: value greaterThanOrEqualTo: anotherValue +! ! + +!Character methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asCharacter + ^self +! ! + +!Character methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asInteger + ^value +! ! + +!Character methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +asLowercase + value < 256 ifTrue: [^Latin1Lowercases at: value + 1]. + ^UnicodeLibrary lowercaseOf: self +! ! + +!Character methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asParameter + ^self codePoint +! ! + +!Character methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asString + | class | + class := self isByteCharacter ifTrue: [String] ifFalse: [WideString]. + ^class with: self +! ! + +!Character methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +asUppercase + value < 256 ifTrue: [^Latin1Uppercases at: value + 1]. + ^UnicodeLibrary uppercaseOf: self +! ! + +!Character methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +between: min and: max + ^min codePoint <= value and: [value <= max codePoint] +! ! + +!Character methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBePrintedAsLiteral + ^true +! ! + +!Character methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +codePoint + ^value +! ! + +!Character methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + ^self +! ! + +!Character methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +digitValue + self isDigit ifTrue: [^value - 48]. + self isAsciiLetter ifFalse: [self error: 'Cannot calculate digitValue']. + value > 96 ifTrue: [^value - 87]. + ^value - 55 +! ! + +!Character methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^value hash +! ! + +!Character methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +highByte + ^value bitShift: -8 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isAlphanumeric + value < 256 ifTrue: [^self isLetter or: [self isDigit]]. + ^UnicodeLibrary isAlphanumeric: self +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isAlphaNumericOrUnderscore + ^self isDigit or: [self isLetter] or: [self = $_] +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isAsciiLetter + value < 65 ifTrue: [^false]. + value < 91 ifTrue: [^true]. + value = 95 ifTrue: [^true]. + value < 97 ifTrue: [^false]. + value < 123 ifTrue: [^true]. + ^false. +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isAsterisk + ^value = 42 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBackslash + ^value = 92 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBacktick + ^value = 96 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBlank + value <= 32 ifTrue: [^true]. + value = 160 ifTrue: [^true]. + value < 16r2000 ifTrue: [^false]. + value < 16r200C ifTrue: [^true]. + value = 16r202F ifTrue: [^true]. + value = 16r205F ifTrue: [^true]. + value = 16r3000 ifTrue: [^true]. + ^false +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isByteCharacter + ^value < 256 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCharacter + ^true +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCircumflex + ^value = 94 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isColon + ^value = 58 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCr + ^value = 13 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDigit + ^value >= 48 and: [value <= 57] +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isHexDigit + ^self isDigit or: [self between: $a and: $f] or: [self between: $A and: $F] +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDollar + ^value = 36 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDollarSign + ^value = 36 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDot + ^value = 46 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDoubleQuote + ^value = 34 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEndOfLine + ^value = 13 | (value = 10) +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEsc + ^self = self class escape +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFixedObject + ^value < 256 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isGreaterThan + ^value = 62 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isHash + ^value = 35 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isIdentifierCharacter + ('$:_' includes: self) ifTrue: [^true]. + ^self isAlphanumeric +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isLeftBracket + ^value = 91 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isLeftCurlyBracket + ^value = 123 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isLessThan + ^value = 60 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isLetter + self isAsciiLetter ifTrue: [^true]. + value < 128 ifTrue: [^false]. + value < 256 ifTrue: [ | byte bit | + byte := #[0x0 0x0 0x0 0x0 0x0 0x4 0x20 0x4 0xFF 0xFF 0x7F 0xFF 0xFF 0xFF 0x7F 0xFF] at: ((value - 128) bitShift: -3) + 1. + bit := (value bitAnd: 7) + 1. + ^(byte bitAt: bit) == 1]. + ^UnicodeLibrary isLetter: self +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isLf + ^value = 10 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isLowercase + value < 256 ifTrue: [^(Latin1Uppercases at: value + 1) !!= self]. + ^UnicodeLibrary isLowercase: self +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMinus + ^value = 45 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isNull + ^value = 0 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isNumeric + value < 49 ifTrue: [^false]. + value <= 58 ifTrue: [^true]. + value < 256 ifTrue: [^value == 179 or: [value == 180 or: [value == 186]]]. + ^UnicodeLibrary isNumeric: self +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isPipe + ^value = 124 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isPlus + ^value = 43 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isPunctuationMark + self = $. ifTrue: [^true]. + self = $; ifTrue: [^true]. + self = $: ifTrue: [^true]. + self = $_ ifTrue: [^true]. + self = $, ifTrue: [^true]. + self = $!! ifTrue: [^true]. + self = $? ifTrue: [^true]. + ^false +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isQuestionMark + ^value = 63 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isRightBracket + ^value = 93 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isRightCurlyBracket + ^value = 125 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isRightParenthesis + ^value = 41 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSemiColon + ^value = 59 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSeparator + self = Space ifTrue: [^true]. + self = Tab ifTrue: [^true]. + self = Cr ifTrue: [^true]. + self = Lf ifTrue: [^true]. + self = Ff ifTrue: [^true]. + ^false +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSingleQuote + ^value = 39 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSpace + ^value = 32 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isTab + ^value = 9 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isUnderscore + ^value = 95 +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isUppercase + value < 256 ifTrue: [^(Latin1Lowercases at: value + 1) !!= self]. + ^UnicodeLibrary isUppercase: self +! ! + +!Character methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isVowel + ^'aAeEiIoOuU' includes: self +! ! + +!Character methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lowByte + ^value bitAnd: 16rFF +! ! + +!Character methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +numericValue + self isDigit ifTrue: [^value - 48]. + self isAsciiLetter ifFalse: [self error: 'Cannot calculate digitValue']. + value > 96 ifTrue: [^value - 87]. + ^value - 55 +! ! + +!Character methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + self isByteCharacter ifFalse: [aStream beWide]. + aStream nextPut: $$; nextPut: self +! ! + +!Character methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +setValue: anInteger + value := anInteger +! ! + +!Character methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +shallowCopy + ^self +! ! + +!Character methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +split: aString + ^aString substringsSplitBy: self +! ! + +!Character methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + self printOn: aStream +! ! + +!Character methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeUTF8On: aStream + " + 16r800 asCharacter utf8 + " + | b1 b2 b3 b4 | + value < 16r80 ifTrue: [^aStream nextBytePut: value]. + value < 16r800 ifTrue: [ + b1 := value bitShift: -6. + b1 := b1 bitOr: 16rC0. + b2 := value bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + ^aStream nextBytePut: b1; nextBytePut: b2]. + value < 16r10000 ifTrue: [ + b1 := value bitShift: -12. + b1 := b1 bitOr: 16rE0. + b2 := value bitShift: -6. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := value bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + ^aStream + nextBytePut: b1; + nextBytePut: b2; + nextBytePut: b3]. + b1 := value bitShift: -18. + b1 := b1 bitOr: 16rF0. + b2 := value bitShift: -12. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := value bitShift: -6. + b3 := b3 bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + b4 := value bitAnd: 16r3F. + b4 := b4 bitOr: 16r80. + ^aStream + nextBytePut: b1; + nextBytePut: b2; + nextBytePut: b3; + nextBytePut: b4 +! ! + +!Character methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf8 + " + 16r800 asCharacter utf8 + " + ^UTF8 current encodeCharacter: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Character class' category: #Kernel! +Character class + instanceVariableNames: 'ByteCharacters'! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +ampersand + ^$& +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +backspace + ^self value: 8 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +backtick + ^$` +! ! + +!Character class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +bee + ^$🐝 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +belongs + ^$∊ +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +bullet + ^Character value: 8226 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +comma + ^$, +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyright + ^$ⓒ +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +cr + ^Cr +! ! + +!Character class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +digitValue: anInteger + | n offset | + n := anInteger asInteger. + offset := n < 10 ifTrue: [48] ifFalse: [55]. + ^self value: n + offset +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +dollar + ^$$ +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +doubleQuote + ^$" +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +downArrow + ^self value: 8595 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +ellipsis + ^$… +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +emdash + ^Emdash +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +emspace + ^Character value: 8195 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +endash + ^Endash +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +enspace + ^Character value: 8194 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +equal + ^$= +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +escape + ^self value: 27 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +exclamation + ^$!! +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +exists + ^$∃ +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +ff + ^self value: 12 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +forAll + ^$∀ +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +ge + ^self value: 16r2265 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +greaterThan + ^$> +! ! + +!Character class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeNamedCharacters + " + Character initializeNamedCharacters + " + | named | + named := self addNamespaceAs: #NamedCharacters. + named + at: #Bell put: 7 asCharacter; + at: #Bs put: 8 asCharacter; + at: #Tab put: 9 asCharacter; + at: #Lf put: 10 asCharacter; + at: #Ff put: 12 asCharacter; + at: #Cr put: 13 asCharacter; + at: #Esc put: 27 asCharacter; + at: #Space put: 32 asCharacter; + at: #Del put: 127 asCharacter; + at: #TimerTick put: 253 asCharacter; + at: #Emdash put: 8212 asCharacter; + at: #Endash put: 8211 asCharacter; + at: #Emspace put: Character emspace; + at: #Enspace put: Character enspace; + at: #Qmspace put: Character qmspace; + at: #Bullet put: Character bullet; + at: #Lquote put: Character lquote; + at: #Rquote put: Character rquote; + at: #Ldblquote put: Character ldblquote; + at: #Rdblquote put: Character rdblquote +! ! + +!Character class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeCharacters + ByteCharacters := (0 to: 255) collect: [:i | super new setValue: i] +! ! + +!Character class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeLatin1Tables + | order uppercases lowercases | + order := #[0x01 0x03 0x04 0x05 0x06 0x07 0x08 0x09 0x0A 0x22 0x23 0x24 0x25 0x26 0x0B 0x0C 0x0D 0x0E 0x0F 0x10 0x11 0x12 0x13 0x14 0x15 0x16 0x17 0x18 0x19 0x1A 0x1B 0x1C 0x20 0x27 0x28 0x29 0x2A 0x2B 0x2C 0x1E 0x2D 0x2E 0x2F 0x4C 0x30 0x1F 0x31 0x32 0x5D 0x61 0x63 0x65 0x67 0x68 0x69 0x6A 0x6B 0x6C 0x33 0x34 0x4D 0x4E 0x4F 0x35 0x36 0x6D 0x7E 0x81 0x85 0x89 0x92 0x94 0x96 0x99 0xA3 0xA4 0xA7 0xA8 0xAB 0xAE 0xBD 0xBF 0xC1 0xC3 0xC6 0xCA 0xD4 0xD6 0xD8 0xDB 0xE0 0x37 0x38 0x39 0x3A 0x3B 0x3C 0x6D 0x7E 0x81 0x85 0x89 0x92 0x94 0x96 0x99 0xA3 0xA4 0xA7 0xA8 0xAB 0xAE 0xBD 0xBF 0xC1 0xC3 0xC6 0xCA 0xD4 0xD6 0xD8 0xDB 0xE0 0x3D 0x3E 0x3F 0x40 0x1D 0x01 0x01 0x01 0x00 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x00 0x01 0x01 0x00 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x01 0x21 0x41 0x48 0x49 0x4A 0x4B 0x42 0x55 0x43 0x56 0x6F 0x51 0x57 0x02 0x58 0x44 0x59 0x50 0x64 0x66 0x45 0x5A 0x5B 0x5C 0x46 0x62 0xB0 0x52 0x5E 0x5F 0x60 0x47 0x73 0x70 0x74 0x79 0x77 0x7A 0x7D 0x82 0x8D 0x8B 0x8F 0x90 0x9C 0x9B 0x9F 0xA0 0x86 0xAC 0xB4 0xB2 0xB6 0xB9 0xB8 0x53 0xBC 0xCE 0xCD 0xD0 0xD2 0xDC 0xC9 0xC5 0x73 0x70 0x74 0x79 0x77 0x7A 0x7D 0x82 0x8D 0x8B 0x8F 0x90 0x9D 0x9B 0x9F 0xA1 0x86 0xAD 0xB4 0xB2 0xB6 0xB9 0xB8 0x54 0xBC 0xCE 0xCD 0xD0 0xD2 0xDC 0xC9 0xDE]. + uppercases := #(0x00 0x01 0x02 0x03 0x04 0x05 0x06 0x07 0x08 0x09 0x0A 0x0B 0x0C 0x0D 0x0E 0x0F 0x10 0x11 0x12 0x13 0x14 0x15 0x16 0x17 0x18 0x19 0x1A 0x1B 0x1C 0x1D 0x1E 0x1F 0x20 0x21 0x22 0x23 0x24 0x25 0x26 0x27 0x28 0x29 0x2A 0x2B 0x2C 0x2D 0x2E 0x2F 0x30 0x31 0x32 0x33 0x34 0x35 0x36 0x37 0x38 0x39 0x3A 0x3B 0x3C 0x3D 0x3E 0x3F 0x40 0x41 0x42 0x43 0x44 0x45 0x46 0x47 0x48 0x49 0x4A 0x4B 0x4C 0x4D 0x4E 0x4F 0x50 0x51 0x52 0x53 0x54 0x55 0x56 0x57 0x58 0x59 0x5A 0x5B 0x5C 0x5D 0x5E 0x5F 0x60 0x41 0x42 0x43 0x44 0x45 0x46 0x47 0x48 0x49 0x4A 0x4B 0x4C 0x4D 0x4E 0x4F 0x50 0x51 0x52 0x53 0x54 0x55 0x56 0x57 0x58 0x59 0x5A 0x7B 0x7C 0x7D 0x7E 0x7F 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0xA0 0xA1 0xA2 0xA3 0xA4 0xA5 0xA6 0xA7 0xA8 0xA9 0xAA 0xAB 0xAC 0xAD 0xAE 0xAF 0xB0 0xB1 0xB2 0xB3 0xB4 0xB5 0xB6 0xB7 0xB8 0xB9 0xBA 0xBB 0xBC 0xBD 0xBE 0xBF 0xC0 0xC1 0xC2 0xC3 0xC4 0xC5 0xC6 0xC7 0xC8 0xC9 0xCA 0xCB 0xCC 0xCD 0xCE 0xCF 0xD0 0xD1 0xD2 0xD3 0xD4 0xD5 0xD6 0xD7 0xD8 0xD9 0xDA 0xDB 0xDC 0xDD 0xDE 0xDF 0xC0 0xC1 0xC2 0xC3 0xC4 0xC5 0xC6 0xC7 0xC8 0xC9 0xCA 0xCB 0xCC 0xCD 0xCE 0xCF 0xD0 0xD1 0xD2 0xD3 0xD4 0xD5 0xD6 0xF7 0xD8 0xD9 0xDA 0xDB 0xDC 0xDD 0xDE 0x9F). + lowercases := #(0x00 0x01 0x02 0x03 0x04 0x05 0x06 0x07 0x08 0x09 0x0A 0x0B 0x0C 0x0D 0x0E 0x0F 0x10 0x11 0x12 0x13 0x14 0x15 0x16 0x17 0x18 0x19 0x1A 0x1B 0x1C 0x1D 0x1E 0x1F 0x20 0x21 0x22 0x23 0x24 0x25 0x26 0x27 0x28 0x29 0x2A 0x2B 0x2C 0x2D 0x2E 0x2F 0x30 0x31 0x32 0x33 0x34 0x35 0x36 0x37 0x38 0x39 0x3A 0x3B 0x3C 0x3D 0x3E 0x3F 0x40 0x61 0x62 0x63 0x64 0x65 0x66 0x67 0x68 0x69 0x6A 0x6B 0x6C 0x6D 0x6E 0x6F 0x70 0x71 0x72 0x73 0x74 0x75 0x76 0x77 0x78 0x79 0x7A 0x5B 0x5C 0x5D 0x5E 0x5F 0x60 0x61 0x62 0x63 0x64 0x65 0x66 0x67 0x68 0x69 0x6A 0x6B 0x6C 0x6D 0x6E 0x6F 0x70 0x71 0x72 0x73 0x74 0x75 0x76 0x77 0x78 0x79 0x7A 0x7B 0x7C 0x7D 0x7E 0x7F 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0xA0 0xA1 0xA2 0xA3 0xA4 0xA5 0xA6 0xA7 0xA8 0xA9 0xAA 0xAB 0xAC 0xAD 0xAE 0xAF 0xB0 0xB1 0xB2 0xB3 0xB4 0xB5 0xB6 0xB7 0xB8 0xB9 0xBA 0xBB 0xBC 0xBD 0xBE 0xBF 0xE0 0xE1 0xE2 0xE3 0xE4 0xE5 0xE6 0xE7 0xE8 0xE9 0xEA 0xEB 0xEC 0xED 0xEE 0xEF 0xF0 0xF1 0xF2 0xF3 0xF4 0xF5 0xF6 0xD7 0xF8 0xF9 0xFA 0xFB 0xFC 0xFD 0xFE 0xDF 0xE0 0xE1 0xE2 0xE3 0xE4 0xE5 0xE6 0xE7 0xE8 0xE9 0xEA 0xEB 0xEC 0xED 0xEE 0xEF 0xF0 0xF1 0xF2 0xF3 0xF4 0xF5 0xF6 0xF7 0xF8 0xF9 0xFA 0xFB 0xFC 0xFD 0xFE 0xFF). + + self + classVarNamed: #Latin1Order put: order; + classVarNamed: #Latin1Uppercases put: (uppercases collect: [:v | Character value: v]); + classVarNamed: #Latin1Lowercases put: (lowercases collect: [:v | Character value: v]) +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +italicA + ^Character value: 16r1D44E +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +ldblquote + ^Character value: 8220 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +le + ^self value: 16r2264 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftArrow + ^self value: 16r2190 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +lessThan + ^$< +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +lf + ^self value: 10 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +lquote + ^Character value: 8216 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +minus + ^$- +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +muchGreater + ^$≫ +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +namedCharacters + ^NamedCharacters +! ! + +!Character class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self shouldNotImplement +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +null + ^self value: 0 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +oplus + " + Character tensor + " + ^8853 asCharacter +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +period + ^$. +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +qmspace + ^Character value: 8197 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +rdblquote + ^Character value: 8221 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightArrow + ^self value: 16r2192 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +rquote + ^Character value: 8217 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +semicolon + ^$; +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +singleQuote + ^$' +! ! + +!Character class methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^1 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +space + ^$ +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +tab + ^self value: 9 +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +tensor + " + Character tensor + " + ^8855 asCharacter +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +underscore + ^$_ +! ! + +!Character class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +upArrow + ^self value: 16r2191 +! ! + +!Character class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: anInteger + ^(anInteger >= 0 and: [anInteger + 1 <= ByteCharacters _size]) + ifTrue: [ByteCharacters _basicAt: anInteger + 1] + ifFalse: [Character basicNew setValue: anInteger] +! ! + + diff --git a/modules/Kernel/CharacterArray.Class.st b/modules/Kernel/CharacterArray.Class.st new file mode 100644 index 00000000..bd96dd56 --- /dev/null +++ b/modules/Kernel/CharacterArray.Class.st @@ -0,0 +1,791 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #CharacterArray category: #Kernel! +ArrayedCollection subclass: #CharacterArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!CharacterArray commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!CharacterArray methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +/ aString + | string tail | + string := (aString notEmpty and: [aString first = $/]) + ifTrue: [aString allButFirst] + ifFalse: [aString]. + self isEmpty ifTrue: [^string]. + tail := string isEmpty ifTrue: [''] ifFalse: ['/' , string]. + ^self last = $/ ifTrue: [self allButLast , tail] ifFalse: [self , tail] +! ! + +!CharacterArray methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +\ aString + ^self, '\', aString +! ! + +!CharacterArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aString + ^(aString <= self) not +! ! + +!CharacterArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<< aString + | min | + min := self size min: aString size. + 1 to: min do: [:i | | a b | + a := (self at: i) asInteger. + b := (aString at: i) asInteger. + a < b ifTrue: [^true]. + a > b ifTrue: [^false]]. + ^self size <= aString size +! ! + +!CharacterArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aString + | iterations | + self isWide == aString isWide ifFalse: [ + ^(self isSymbol or: [aString isSymbol]) + ifTrue: [self asWideSymbol <= aString asWideSymbol] + ifFalse: [self asWideString <= aString asWideString]]. + iterations := self size min: aString size. + 1 to: iterations do: [:i | | a b | + a := (self at: i) asLowercase. + b := (aString at: i) asLowercase. + a < b ifTrue: [^true]. + a > b ifTrue: [^false]]. + ^iterations = self size +! ! + +!CharacterArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aString + ^(self <= aString) not +! ! + +!CharacterArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aString + aString isString ifFalse: [^self error: 'argument is not a String']. + ^aString <= self +! ! + +!CharacterArray methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +abbreviatedTo: n + " + 'A very long string to be curtailed' abbreviatedTo: 30 + " + self size <= n ifTrue: [^self]. + ^(self copyFrom: 1 to: (n - 1 max: 1)) , Character ellipsis asString +! ! + +!CharacterArray methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +article + | article first letter second | + self isEmpty ifTrue: [^self]. + article := self first isVowel ifTrue: ['an'] ifFalse: ['a']. + first := self first asLowercase. + letter := self size = 1. + second := letter ifFalse: [self second asLowercase]. + (first = $f and: [letter orNot: ['aeiloru' includes: second]]) + ifTrue: [^'an']. + first = $u ifTrue: [ + (letter or: ['ck' includes: second]) ifTrue: [^'a']. + second = $n + ifTrue: [(self size = 2 or: [self third isVowel]) ifTrue: [^'a']]]. + (first = $e and: [second = $u]) ifTrue: [^'a']. + ^article +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asFloat + ^Float fromString: self +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asInteger + ^Integer fromString: self +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asLowercase + | changed size lowercase | + changed := false. + size := self size. + lowercase := self species new: size. + 1 to: size do: [:index | | c lc | + c := self at: index. + lc := c asLowercase. + changed := c !!= lc | changed. + lowercase at: index put: lc]. + ^changed ifTrue: [lowercase] ifFalse: [self] +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asNumber + ^Number fromString: self +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asString + ^self +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asUppercase + | changed answer size c uc | + changed := false. + size := self size. + answer := self species new: size. + 1 to: size do: [:index | + c := self at: index. + uc := c asUppercase. + changed := c ~~ uc | changed. + answer at: index put: uc]. + ^changed ifTrue: [answer] ifFalse: [self] +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asWideString + | n wide | + n := self size. + wide := WideString new: n. + 1 to: n do: [:i | | byte | + byte := self byteAt: i. + wide basicAt: i - 1 * 4 + 1 put: byte]. + ^wide +! ! + +!CharacterArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger <= self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^self characterAtValid: anInteger +! ! + +!CharacterArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger <= self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^self characterAtValid: anInteger +! ! + +!CharacterArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger put: aCharacter + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger <= self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + aCharacter isCharacter + ifFalse: [^self + error: self class name , ' can''t hold ' , aCharacter class name]. + aCharacter isByteCharacter + ifFalse: [^self + error: 'Strings cannot hold non-latin1 characters']. + ^self _byteAt: anInteger put: aCharacter asInteger +! ! + +!CharacterArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: anInteger + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger <= self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^self _byteAt: anInteger +! ! + +!CharacterArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: position put: asciiValue + position _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= position and: [position <= self _size]) + ifFalse: [^self outOfBoundsIndex: position]. + (0 <= asciiValue and: [asciiValue < 256]) + ifFalse: [^self error: 'invalid character']. + ^self _byteAt: position put: asciiValue +! ! + +!CharacterArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBePrintedAsLiteral + ^true +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +capitalized + | c | + self isEmpty ifTrue: [^self]. + c := self first. + c isUppercase ifTrue: [^self]. + ^self copy at: 1 put: c asUppercase; yourself +! ! + +!CharacterArray methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterAtValid: index + | value | + value := self _byteAt: index. + ^Character value: value +! ! + +!CharacterArray methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:27:38'! +checkCharacter: aCharacter + aCharacter isCharacter + ifFalse: [^self error: 'Improper store into indexable object'] +! ! + +!CharacterArray methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +codeAt: i + ^self byteAt: i +! ! + +!CharacterArray methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +doubleQuoted + " + 'hello' doubleQuoted + " + self isEmpty ifTrue: [^self class new: 2 withAll: $"]. + ^(self first = $" and: [self last = $"]) + ifTrue: [self] + ifFalse: [$" , self copyWith: $"] +! ! + +!CharacterArray methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +eol + | n code | + n := self size. + n = 0 ifTrue: [^nil]. + code := self codeAt: n. + code = 13 ifTrue: [^String cr]. + code = 10 ifTrue: [ + ^n = 1 + ifTrue: [String lf] + ifFalse: [(self codeAt: n - 1) = 13 + ifTrue: [String crlf] + ifFalse: [String lf]]]. + 1 to: n - 1 do: [:i | + code := self codeAt: i. + code = 13 + ifTrue: [^(self codeAt: i + 1) = 10 + ifTrue: [String crlf] + ifFalse: [String cr]]. + code = 10 ifTrue: [^String lf]]. + ^nil +! ! + +!CharacterArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +equals: aString + | size | + self class == aString class ifFalse: [^false]. + size := self basicSize. + size = aString basicSize ifFalse: [^false]. + 1 + to: size + do: [:i | (aString _byteAt: i) = (self _byteAt: i) ifFalse: [^false]]. + ^true +! ! + +!CharacterArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +equalsCaseInsensitive: aString + self size = aString size ifFalse: [^false]. + ^self <= aString andNot: [self < aString] +! ! + +!CharacterArray methodsFor: 'filenames' stamp: 'KenD 28/Jun/2026 13:27:38'! +fileExtension + ^self asFilename extension +! ! + +!CharacterArray methodsFor: 'filenames' stamp: 'KenD 28/Jun/2026 13:27:38'! +fileName + ^self asFilename withoutExtension asString +! ! + +!CharacterArray methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +fileNameOnly + " + 'c:\dir\filename.ext' fileNameOnly + " + ^self asFilename fileNameOnly +! ! + +!CharacterArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + | hash | + hash := self size. + 1 + to: hash + do: [:i | hash := (hash hashMultiply: 16r19660D) bitXor: (self byteAt: i)]. + ^hash +! ! + +!CharacterArray methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +includes: aCharacter + aCharacter isCharacter ifFalse: [^false]. + 1 to: self size do: [:i | (self at: i) = aCharacter ifTrue: [^true]]. + ^false +! ! + +!CharacterArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +includesString: aString + ^aString isEmpty or: [(self indexOfString: aString) > 0] +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfLastChar: aCharacter + self size + to: 1 + by: -1 + do: [:index | (self at: index) = aCharacter ifTrue: [^index]]. + ^0 +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfLastString: aString + ^self indexOfLastString: aString before: self size +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfLastString: aString before: anInteger + ^self indexOfLastString: aString from: 1 to: anInteger +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfLastString: aString from: start to: stop + | n limit base i | + n := aString size. + limit := n + start. + base := stop + 1. + i := 1. + [ + base < limit ifTrue: [^0]. + i <= n] + whileTrue: [ + i := (self at: base - i) = (aString at: n - i + 1) ifTrue: [i + 1] ifFalse: [ + base := base - 1. + 1]]. + ^i > 1 ifTrue: [base - n] ifFalse: [0] +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfString: aString + ^self indexOfString: aString startingAt: 1 +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfString: aString from: start to: stop + | n limit base i | + n := aString size. + limit := stop - n. + base := start - 1. + i := 1. + [ + base > limit ifTrue: [^0]. + i <= n] + whileTrue: [ + i := (self at: base + i) = (aString at: i) ifTrue: [i + 1] ifFalse: [ + base := base + 1. + 1]]. + ^i > 1 ifTrue: [base + 1] ifFalse: [0] +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfString: aString startingAt: anInteger + ^self indexOfString: aString from: anInteger to: self size +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfSubcollection: aString from: start to: stop td1: anArray + ^self indexOfString: aString from: start to: stop td1: anArray +! ! + +!CharacterArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isByteCompliant + ^true +! ! + +!CharacterArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isByteString + ^true +! ! + +!CharacterArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isString + ^true +! ! + +!CharacterArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWide + ^false +! ! + +!CharacterArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWideString + ^false +! ! + +!CharacterArray methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +lineAt: index + | read start line | + read := self readStream. + start := 1. + line := 1. + [read atEnd] whileFalse: [| end | + end := start + read nextLine size. + (index between: start and: end) ifTrue: [^line]. + line := line + 1. + start := end] +! ! + +!CharacterArray methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +lines + | read | + read := self readStream. + ^Array streamContents: [:write | + [ + write nextPut: read nextLine trimBlanks. + read atEnd] whileFalse] +! ! + +!CharacterArray methodsFor: 'filenames' stamp: 'KenD 28/Jun/2026 13:27:38'! +pathName + " + 'c:\dir\name.ext' pathName + " + | slash1 slash2 index | + self asFilename directoryExists ifTrue: [^self]. + slash1 := $\. + slash2 := $/. + index := self findLast: [:char | char == slash1 or: [char == slash2]] ifAbsent: [^'.']. + ^self copyFrom: 1 to: index - 1 +! ! + +!CharacterArray methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveSize + ^self _size +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +reduced + ^self +! ! + +!CharacterArray methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceAll: aString with: anotherString + | string strm index fragment n | + string := aString asString. + string isEmpty ifTrue: [^self]. + index := self indexOfSubcollection: string startingAt: 1. + index = 0 ifTrue: [^self]. + strm := self asString class new writeStream. + fragment := self copyFrom: 1 to: index - 1. + strm nextPutAll: fragment. + n := string size. + [index > 0] whileTrue: [| next limit | + next := self indexOfString: string from: index + n to: self size. + limit := next = 0 ifTrue: [self size + 1] ifFalse: [next]. + fragment := self copyFrom: index + n - 1 + 1 to: limit - 1. + strm nextPutAll: anotherString; nextPutAll: fragment. + index := next]. + ^strm contents +! ! + +!CharacterArray methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceAllChar: aCharacter with: aString + | index writer string n | + self ASSERT: aCharacter isCharacter. + index := self indexOf: aCharacter. + index = 0 ifTrue: [^self]. + writer := self class new writeStream. + string := self copyFrom: 1 to: index - 1. + writer nextPutAll: string; nextPutAll: aString. + n := self size. + [index + 1 <= n] whileTrue: [| next | + next := self + indexOf: aCharacter + between: index + 1 + and: n + ifAbsent: [n + 1]. + string := self copyFrom: index + 1 to: next - 1. + writer nextPutAll: string. + next <= n ifTrue: [writer nextPutAll: aString]. + index := next]. + ^writer contents +! ! + +!CharacterArray methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceAllChar: aCharacter withChar: anotherCharacter + | copy | + copy := self copy. + 1 + to: self size + do: [:i | (self at: i) = aCharacter + ifTrue: [copy at: i put: anotherCharacter]]. + ^copy +! ! + +!CharacterArray methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +shortAtOffset: offset + | integer | + integer := self uShortAtOffset: offset. + 16r7FFF < integer ifTrue: [integer := integer - 16r10000]. + ^integer +! ! + +!CharacterArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self _size +! ! + +!CharacterArray methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +split: aString + " + ' +- ' split: '2 +- 3 +- 4 +- 5' + " + | stream substrings | + self size = 1 ifTrue: [^self first split: aString]. + stream := aString readStream. + substrings := OrderedCollection new. + [stream atEnd] whileFalse: [| s | + s := stream upToAll: self. + substrings add: s]. + ^substrings +! ! + +!CharacterArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + self printOn: aStream +! ! + +!CharacterArray methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +stringHash + | hash | + hash := self size. + 1 + to: hash + do: [:i | hash := (hash hashMultiply: 16r19660D) bitXor: (self byteAt: i)]. + ^hash +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +substrings + | substrings start size | + substrings := OrderedCollection new. + start := 1. + size := self size. + [start <= size] whileTrue: [| string stop | + [start <= size and: [(self at: start) isBlank]] + whileTrue: [start := start + 1]. + stop := start. + [stop <= size and: [(self at: stop) isBlank not]] + whileTrue: [stop := stop + 1]. + stop > start ifTrue: [ + string := self copyFrom: start to: stop - 1. + substrings add: string]. + start := stop]. + ^substrings asArray +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +substringsSplitBy: aCharacter + | substrings start size | + substrings := OrderedCollection new. + start := 1. + size := self size. + [start <= size] whileTrue: [| stop string | + stop := start. + [stop <= size andNot: [(self at: stop) = aCharacter]] + whileTrue: [stop := stop + 1]. + stop >= start ifTrue: [ + string := self copyFrom: start to: stop - 1. + substrings add: string]. + start := stop + 1]. + ^substrings asArray +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +subwords + | i0 starting | + i0 := 1. + starting := false. + ^Array streamContents: [:strm | + 1 to: self size do: [:i | | char | + char := self at: i. + (char isBlank or: [char isPunctuationMark]) + ifTrue: [ + starting ifFalse: [strm nextPut: (self copyFrom: i0 to: i - 1)]. + i0 := i + 1. + starting := true] + ifFalse: [ + (self isWordEnd: i) + ifTrue: [ + strm nextPut: (self copyFrom: i0 to: i). + i0 := i + 1. + starting := true] + ifFalse: [starting := false]]]. + starting ifFalse: [strm nextPut: (self copyFrom: i0)]] +! ! + +!CharacterArray methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +trimBlanks + | start end | + start := self findFirst: [:char | char isBlank not] ifAbsent: [^'']. + end := self findLast: [:char | char isBlank not]. + ^self copyFrom: start to: end +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +trimComments + | input result | + input := self readStream. + result := input upTo: $". + [input skipTo: $"] whileTrue: [result := result , (input upTo: $")]. + ^result +! ! + +!CharacterArray methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +trimNullEnd + | index | + index := self size. + [index > 0 and: [(self codeAt: index) = 0]] whileTrue: [index := index - 1]. + ^index < self size ifTrue: [self copyFrom: 1 to: index] ifFalse: [self] +! ! + +!CharacterArray methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +trimPrefix: aString + ^(self beginsWith: aString) + ifTrue: [self allButFirst: aString size] + ifFalse: [self] +! ! + +!CharacterArray methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +trimTail: aString + ^(self endsWith: aString) + ifTrue: [self allButLast: aString size] + ifFalse: [self] +! ! + +!CharacterArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLongAtOffset: offset + | low high | + low := self uShortAtOffset: offset. + high := self uShortAtOffset: offset + 2. + high := high bitShift: 16. + ^high + low +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +unformatted + ^self +! ! + +!CharacterArray methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upTo: aCharacter + | index | + index := self findFirst: [:ch | ch = aCharacter] ifAbsent: [self size + 1]. + ^self copyFrom: 1 to: index - 1 +! ! + +!CharacterArray methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +uShortAtOffset: anInteger + | size index lo hi | + size := self basicSize. + index := anInteger + 1. + lo := index > size ifTrue: [0] ifFalse: [self byteAt: index]. + hi := index + 1 > size ifTrue: [0] ifFalse: [self byteAt: index + 1]. + ^(hi bitShift: 8) + lo +! ! + +!CharacterArray methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +withArticle + ^self article , ' ' , self +! ! + +!CharacterArray methodsFor: 'gui support' stamp: 'KenD 28/Jun/2026 13:27:38'! +withCrs + | copy | + copy := self copy. + copy withIndexDo: [:ci :i | ci = $\ ifTrue: [copy at: i put: Cr]]. + ^copy +! ! + +!CharacterArray methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +withoutCrLf + | read blank | + read := self readStream. + blank := false. + ^self class streamContents: [:strm | + [read atEnd] whileFalse: [| c ch | + ch := read next. + (ch isCr or: [ch = Lf]) + ifTrue: [blank ifFalse: [c := Space]] + ifFalse: [c := ch]. + c notNil ifTrue: [ + strm nextPut: c. + blank := c isBlank]]] +! ! + +!CharacterArray methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +withoutLineEndings + | read blank | + read := self readStream. + blank := false. + ^self class streamContents: [:strm | + [read atEnd] whileFalse: [| c ch | + ch := read next. + (ch = Cr or: [ch = Lf]) + ifTrue: [blank ifFalse: [c := Space]] + ifFalse: [c := ch]. + c notNil ifTrue: [ + strm nextPut: c. + blank := c isBlank]]] +! ! + +!CharacterArray methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +withoutSeparators + ^self reject: [:c | c isBlank] +! ! + +!CharacterArray methodsFor: 'unix' stamp: 'KenD 28/Jun/2026 13:27:38'! +withUnixEOL + | size left replace right | + size := self size. + size = 0 ifTrue: [^'']. + left := self at: size. + right := self at: 1. + replace := [:char | char = Cr ifTrue: [Lf] ifFalse: [char]]. + ^String streamContents: [:stream | + 1 to: self size - 1 do: [:i | + left := self at: i + 1. + (right = Cr and: [left = Lf]) + ifFalse: [stream nextPut: (replace value: right)]. + right := left]. + stream nextPut: (replace value: left)] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CharacterArray class' category: #Kernel! +CharacterArray class + instanceVariableNames: ''! + +!CharacterArray class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromSubstrings: substrings separatedBy: separatorChar + | stream | + stream := self new writeStream. + substrings + do: [:string | stream nextPutAll: string asString] + separatedBy: [stream nextPut: separatorChar]. + ^stream contents +! ! + +!CharacterArray class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializePools + self addNamespace: Character namedCharacters +! ! + +!CharacterArray class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +lf + ^self with: Lf +! ! + + diff --git a/modules/Kernel/Class.Class.st b/modules/Kernel/Class.Class.st new file mode 100644 index 00000000..5309eeed --- /dev/null +++ b/modules/Kernel/Class.Class.st @@ -0,0 +1,347 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Class category: #Kernel! +Species subclass: #Class + instanceVariableNames: 'name subclasses namespaces module' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Class commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Class methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_lookupName: aSymbol + | current vars result | + current := self. + [ + vars := current classVariables. + vars == nil ifFalse: [ + result := vars _namespaceLookup: aSymbol. + result == nil ifFalse: [^result]. + ]. + current := current superclass. + current == nil] whileFalse. + ^module _namespaceLookup: aSymbol. +! ! + +!Class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +addNamespace + ^self addNamespace: Namespace new. +! ! + +!Class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +addNamespace: aNamespace + " + first namespace are class variables, remaining ones are local pools of the class + " + namespaces isEmpty ifTrue: [namespaces := Array with: Namespace new]. + namespaces := namespaces copyWith: aNamespace. + ^aNamespace +! ! + +!Class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +addNamespaceAs: aSymbol + | names | + names := self addNamespace. + ^self classVarNamed: aSymbol put: names +! ! + +!Species methodsFor: 'flags' stamp: 'KenD 28/Jun/2026 13:27:38'! +beBytes + format := Variable +! ! + +!Class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +beDeleted + | behavior md | + self behavior: DeletedClass instanceBehavior. + name := ('Deleted ' , self symbol) asSymbol. + behavior := self instanceBehavior. + md := MethodDictionary new. + self withAllSuperclasses reverseDo: [:c | + c selectors do: [:s | | cm | + cm := c >> s. + cm notNil ifTrue: [md at: s put: cm]]]. + behavior methods: md; next: nil. + instanceVariables := self allInstVarNames. + superclass := ProtoObject +! ! + +!Class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +beNamed: aSymbol in: aSmalltalkSystem + | symbol assoc | + symbol := aSymbol asSymbol. + assoc := aSmalltalkSystem associationClass key: symbol value: self. + aSmalltalkSystem basicAdd: assoc. + name := symbol +! ! + +!Class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +beSubclassOf: aClass + self installer superclass: aClass; install +! ! + +!Class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBeDeleted + ^self !!== Class +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVariables + ^namespaces isEmpty ifTrue: [Namespace new] ifFalse: [namespaces first] +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVariables: aNamespace + namespaces isEmpty + ifTrue: [namespaces := Array with: aNamespace] + ifFalse: [namespaces at: 1 put: aNamespace]. + (aNamespace isEmpty and: [namespaces size = 1]) + ifTrue: [namespaces := #()] +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVarNamed: aString + ^self classVariables at: aString ifAbsent: [] +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVarNamed: aString put: anObject + namespaces isEmpty ifTrue: [self addNamespace]. + ^namespaces first at: aString put: anObject +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVarNames + ^self classVariables keys +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVarNames: aCollection + | new old | + new := Namespace new. + old := self classVariables. + + aCollection do: [:k | | assoc | + assoc := old associationAt: k ifAbsent: [k -> nil]. + new add: assoc]. + + self classVariables: new. +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +comment + ^self organization isNil ifTrue: [''] ifFalse: [self organization comment] +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +comment: aString + self organization comment: aString +! ! + +!Class methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +delete + self canBeDeleted + ifFalse: [self error: 'System Classes cannot be removed.']. + Smalltalk removeClass: self +! ! + +!Class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +duplicate + | copy meta md | + copy := self objectShallowCopy buildBehavior. + md := copy methodDictionary. + md keysAndValuesDo: [:selector :method | md at: selector put: method copy]. + meta := self class objectShallowCopy instanceClass: copy; buildBehavior. + md := meta methodDictionary. + md keysAndValuesDo: [:selector :method | md at: selector put: method copy]. + copy behavior: meta instanceBehavior; subclasses: #(). + ^copy +! ! + +!Class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +duplicateHierarchy + | copy | + copy := self duplicate. + self subspecies do: [:s | | child | + child := s duplicateHierarchyFrom: self with: copy. + child basicBeSubclassOf: copy]. + ^copy +! ! + +!Class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +duplicateHierarchyFrom: aClass with: aClassCopy + | copy | + self == aClass ifTrue: [^aClassCopy]. + copy := self duplicate. + self subspecies do: [:s | | child | + child := s duplicateHierarchyFrom: aClass with: aClassCopy. + child basicBeSubclassOf: copy]. + ^copy +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +fillFrom: aClass + | pools | + super fillFrom: aClass. + self == aClass ifTrue: [^self]. + self classVariables: aClass classVariables. + self class fillFrom: aClass class +! ! + +!Class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasSubclasses + ^self subclasses size > 0 +! ! + +!Class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeFrom: aSpecies + | md | + superclass := aSpecies. + namespaces := #(). + md := MethodDictionary new. + instanceBehavior := Behavior with: md. + instanceBehavior classBinding: self. + format := Object format. + superclass notNil ifTrue: [ + instanceBehavior next: superclass instanceBehavior. + format := superclass format] +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instanceClass + ^self +! ! + +!Class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isClass + ^true +! ! + +!Class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDeleted + ^false +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +module + ^module +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +module: aModule + module := aModule +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name + ^name asString +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name: aSymbol + name := aSymbol asSymbol +! ! + +!Class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +namespaces + ^namespaces +! ! + +!Class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +needsReinstallation + self hasInstanceBehavior ifTrue: [^true]. + superclass isNil ifTrue: [^false]. + self instSize - self instVarNames size = superclass instSize + ifFalse: [^true]. + self class instSize - self class instVarNames size + = self class superclass instSize + ifFalse: [^true]. + ^self installer shouldRecomputeBehavior +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +pointer: pointers variable: variable + | flags bits | + flags := 0. + variable ifTrue: [flags := flags | Variable]. + format := pointers + ifTrue: [ + flags := flags | Pointers. + flags | self instSize] + ifFalse: [flags]. + variable ifTrue: [ + bits := Variable | Pointers. + flags := flags & bits. + self allSubclasses + do: [:cls | cls format: cls format & bits bitInvert | flags]] +! ! + +!Class methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeFromSystem + self allInstances notEmpty + ifTrue: [^self error: 'There are instances of this class']. + self delete +! ! + +!Class methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeSubclass: aClass + subclasses isNil ifTrue: [^self]. + subclasses := subclasses copyWithout: aClass +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +subclasses + subclasses isNil ifTrue: [^#()]. + ^name == #Class + ifTrue: [subclasses reject: [:s | s isMetaclass]] + ifFalse: [subclasses] +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +subclasses: aCollection + subclasses := aCollection isEmpty ifFalse: [aCollection asArray] +! ! + +!Class methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +subclassesDo: aBlock + subclasses isNil ifTrue: [^self]. + subclasses + select: [:cls | cls notNil] + thenDo: [:c | aBlock evaluateWith: c] +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +subspecies + subclasses isNil ifTrue: [^#()]. + ^subclasses +! ! + +!Class methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +subspeciesDo: aBlock + subclasses isNil ifTrue: [^self]. + self subspecies do: aBlock +! ! + +!Class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +symbol + ^name +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Class class' category: #Kernel! +Class class + instanceVariableNames: ''! + +!Class class methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +newSubclassOf: aClass + | meta | + meta := Metaclass new beSubclassOf: aClass class. + ^meta instanceClass module: Kernel; initializeFrom: aClass. +! ! + + diff --git a/modules/Kernel/ClassOrganizer.Class.st b/modules/Kernel/ClassOrganizer.Class.st new file mode 100644 index 00000000..a7ecd7f0 --- /dev/null +++ b/modules/Kernel/ClassOrganizer.Class.st @@ -0,0 +1,300 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ClassOrganizer category: #Kernel! +Object subclass: #ClassOrganizer + instanceVariableNames: 'comment categories selectors author timestamp prev' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ClassOrganizer commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +addCategory: aString + | s | + ^(self selectorsFor: (s := aString asSymbol)) + ifNil: [ + self categories add: s. + selectors add: OrderedCollection new]. + +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSelectors + selectors isNil ifTrue: [^#()]. + ^selectors + inject: Set new + into: [:result :each | result addAll: each; yourself] +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +author + ^author +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +author: aString + author := aString +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +categories + categories isNil ifTrue: [ + categories := OrderedCollection new. + selectors := OrderedCollection new]. + ^categories +! ! + +!ClassOrganizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +categoriesOn: aClass + categories isNil ifTrue: [ + categories := OrderedCollection new. + selectors := OrderedCollection new]. + self checkDefaultCategoryOn: aClass. + ^categories +! ! + +!ClassOrganizer methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +categoryFor: element + | index | + ^selectors isNil ifFalse: [ + index := selectors + findFirst: [:one | one includes: element] + ifAbsent: [^nil]. + categories at: index] +! ! + +!ClassOrganizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +checkDefaultCategoryOn: aClass + | index unclassified all | + categories isNil ifTrue: [^self]. + index := categories indexOf: self class default. + index > 0 ifTrue: [ + categories removeIndex: index. + selectors removeIndex: index]. + unclassified := OrderedCollection new. + all := self allSelectors. + aClass selectors + do: [:s | (all includes: s) ifFalse: [unclassified add: s]]. + unclassified notEmpty + ifTrue: [self classifyAll: unclassified under: self class default] +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +classify: element + element == #doit ifTrue: [^self]. + (self categoryFor: element) isNil + ifTrue: [self classify: element under: self class default] +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +classify: element under: category + | protocol | + self remove: element. + protocol := self getSelectorsFor: category. + protocol add: element +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +classifyAll: elements under: category + | protocol | + elements do: [:s | self remove: s]. + protocol := self getSelectorsFor: category. + protocol addAll: elements +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +comment + ^comment ifNil: [''] +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +comment: aString + comment := aString +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +down: category + | index | + index := categories indexOf: category. + index = categories size ifTrue: [^self]. + categories swap: index with: index + 1. + selectors swap: index with: index + 1 +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +getSelectorsFor: heading + | h | + h := heading isNil ifTrue: [self class default] ifFalse: [heading]. + ^(self selectorsFor: h) ifNil: [self addCategory: h] +! ! + +!ClassOrganizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasValidSelectorsIn: aClass + | valid | + valid := aClass selectors. + ^self allSelectors conform: [:s | valid includes: s] +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +move: element to: category + self + remove: element; + classify: element under: category +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +moveCategory: category to: integer + | index s | + (integer between: 1 and: categories size) ifFalse: [^self]. + index := categories indexOf: category. + index = integer ifTrue: [^self]. + index = 0 ifTrue: [^self]. + categories + removeIndex: index; + add: category beforeIndex: integer. + s := selectors at: index. + selectors + removeIndex: index; + add: s beforeIndex: integer +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +position + ^prev +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +position: anInteger + prev := anInteger +! ! + +!ClassOrganizer methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +postCopy + categories := categories copy. + selectors := selectors copy +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prev + ^prev +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prev: ref + self ASSERT: false. + prev := ref +! ! + +!ClassOrganizer methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +rebuild + | n prevCat | + prev := selectors. + n := categories asSet size. + selectors := Array new: n. + prevCat := categories. + categories := OrderedCollection new: n. + prevCat with: prev do: [:cat :sels | | i | + i := categories indexOf: cat. + i = 0 ifTrue: [ + categories add: cat. + i := categories size]. + (selectors at: i) + ifNil: [selectors at: i put: sels] + ifNotNil: [:c | c addAll: sels]]. + selectors := selectors asOrderedCollection +! ! + +!ClassOrganizer methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: element + selectors isNil ifTrue: [^self]. + selectors do: [:each | each remove: element ifAbsent: nil] +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeCategory: aString + | index | + categories isNil ifTrue: [^self]. + index := categories indexOf: aString asSymbol. + index = 0 ifTrue: [^self]. + categories removeIndex: index. + selectors removeIndex: index +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +renameCategory: aSymbol toBe: anotherSymbol + | index existing protocol | + categories isNil ifTrue: [^self]. + index := categories indexOf: aSymbol asSymbol ifAbsent: [^self]. + existing := categories indexOf: anotherSymbol asSymbol ifAbsent: nil. + existing isNil + ifTrue: [categories at: index put: anotherSymbol asSymbol] + ifFalse: [ + protocol := selectors at: index. + protocol do: [:selector | self move: selector to: anotherSymbol]. + self removeCategory: aSymbol] +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +reorganizeWith: categoryCollection + categoryCollection withIndexDo: [:c :i | self moveCategory: c to: i] +! ! + +!ClassOrganizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +selectors + ^selectors +! ! + +!ClassOrganizer methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +selectorsFor: aString + | index | + categories isNil ifTrue: [^nil]. + index := categories indexOf: aString asSymbol. + index = 0 ifTrue: [^nil]. + ^selectors at: index +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +timestamp + ^timestamp +! ! + +!ClassOrganizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +timestamp: aTimestamp + timestamp := aTimestamp +! ! + +!ClassOrganizer methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +up: heading + | index | + index := categories indexOf: heading. + index = 1 ifTrue: [^self]. + categories swap: index with: index - 1. + selectors swap: index with: index - 1 +! ! + +!ClassOrganizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +updateOn: aClass + | valid | + valid := aClass selectors. + selectors + withIndexDo: [:c :i | selectors + at: i + put: (c select: [:s | valid includes: s])] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ClassOrganizer class' category: #Kernel! +ClassOrganizer class + instanceVariableNames: ''! + +!ClassOrganizer class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +default + ^#unclassified +! ! + + diff --git a/modules/Kernel/Closure.Class.st b/modules/Kernel/Closure.Class.st new file mode 100644 index 00000000..49498dba --- /dev/null +++ b/modules/Kernel/Closure.Class.st @@ -0,0 +1,379 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Closure category: #Kernel! +Object subclass: #Closure + instanceVariableNames: 'block homeFrame' + classVariableNames: 'Indexes' + poolDictionaries: '' + category: 'Kernel'! +!Closure commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Closure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +argumentCount + ^block argumentCount +! ! + +!Closure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +arity + ^block arity +! ! + +!Closure methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +arityError: anInteger + | arity msg count | + arity := block argumentCount. + count := anInteger = 0 ifTrue: ['none'] ifFalse: [anInteger asString]. + msg := 'The ' , self class name , ' expects ' , arity printString + , (' argument' pluralize: arity > 1) + , ', but was called with ' + , count. + ^self error: msg +! ! + +!Closure methodsFor: 'ffi' stamp: 'KenD 28/Jun/2026 13:27:38'! +asCallback + #ClosureAsCallback. + ^self errorVMSpecific +! ! + +!Closure methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger + anInteger _isSmallInteger ifFalse: [^self outOfBoundsIndex: anInteger]. + (1 <= anInteger and: [anInteger <= self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^self _basicAt: anInteger +! ! + +!Closure methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +block + ^block +! ! + +!Closure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +blockNumber + ^block blockNumber +! ! + +!Closure methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +cull: a + ^self argumentCount < 1 + ifTrue: [self value] + ifFalse: [self value: a] +! ! + +!Closure methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +cull: a cull: b + ^self argumentCount < 2 + ifTrue: [self cull: a] + ifFalse: [self value: a value: b] +! ! + +!Closure methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aClosure + 1 to: self size do: [:index | | slot | + slot := self at: index. + aClosure value: slot] +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +ensure: aBlock + ^Processor activeProcess evaluate: self ensuring: aBlock +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluate + ^self value +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateAtomically + self errorVMSpecific +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateFor: anObject + ^self value: anObject +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWith: value + self errorVMSpecific +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWith: anObject with: anotherObject + self errorVMSpecific +! ! + +!Closure methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWithArguments: anArray + | n args | + n := self argumentCount. + n = 0 ifTrue: [^self value]. + args := anArray size > n + ifTrue: [anArray copyFrom: 1 to: n] + ifFalse: [anArray]. + ^self valueWithArguments: args +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +fork + ^self newProcess fork +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +forkAt: aNumber + ^self forkAt: aNumber named: 'forked from block' +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +forkAt: aNumber named: aString + ^self newProcess name: aString; priority: aNumber; fork +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +forkNamed: aString + ^self forkAt: Processor activePriority named: aString +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +forkThread + ^Thread newOn: self +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasMethodEnvironment + ^self size >= ParentEnvironmentIndex +! ! + +!Closure methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifCurtailed: exceptionClosure + | success | + success := false. + ^[ + self value. + success := true] + ensure: [success ifFalse: [exceptionClosure value]] +! ! + +!Closure methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBlockClosure + " + FIXME: fix senders and remove me + " + ^true +! ! + +!Closure methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isClosure + ^true +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +method + ^block method +! ! + +!Closure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +method: aCompiledMethod + block := aCompiledMethod at: block templateIndex +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodEnvironment + ^self at: ParentEnvironmentIndex +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodEnvironment: environment + self at: ParentEnvironmentIndex put: environment +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +needsArgument + ^self argumentCount > 0 +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +newProcess + ^Process sending: #value to: self +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +newProcessWith: anArray + | message | + message := MessageSend + receiver: self + selector: #valueWithArguments: + argument: anArray. + ^Process evaluating: message +! ! + +!Closure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +numArgs + ^self argumentCount +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aClass do: aClosure + ^ExceptionHandler handle: aClass with: aClosure during: self +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: exception1 do: closure1 on: exception2 do: closure2 + ^self on: exception1 , exception2 do: [:ex | | handler | + handler := (exception1 includesException: ex) + ifTrue: [closure1] + ifFalse: [closure2]. + handler evaluateWith: ex] +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + self class printOn: aStream. + aStream nextPut: $(. + block basicPrintOn: aStream. + (1 to: self size) + do: [:i | | field | + field := self at: i. + field printOn: aStream] + separatedBy: [aStream space]. + aStream nextPut: $) +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver + ^self at: ReceiverIndex +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject + self at: ReceiverIndex put: anObject +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +repeat + [true] whileTrue: [self value] +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +repeatUntil: aBlock + [ + self value. + aBlock value] whileFalse +! ! + +!Closure methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +return: result + ^Processor activeProcess nonLocalReturn: result home: homeFrame +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +spawnAndWait + | s result | + s := Semaphore new. + [result := self ensure: [s signal]] fork. + s wait. + ^result +! ! + +!Closure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tempCount + ^block tempCount +! ! + +!Closure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +templateIndex + ^block templateIndex +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +value + self errorVMSpecific +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: value + self errorVMSpecific +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: first value: second + self errorVMSpecific +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: first value: second value: third + self errorVMSpecific +! ! + +!Closure methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: arg1 value: arg2 value: arg3 value: arg4 + ^self valueWithArguments: {arg1. arg2. arg3. arg4} +! ! + +!Closure methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueSelector + ^block valueSelector +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueWithArguments: arguments + self errorVMSpecific +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +whileFalse + ^[self value] whileFalse: [] +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +whileFalse: aBlock + self errorVMSpecific +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +whileTrue + ^[self value] whileTrue: [] +! ! + +!Closure methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +whileTrue: aBlock + self errorVMSpecific +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Closure class' category: #Kernel! +Closure class + instanceVariableNames: 'Indexes'! + +!Closure class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeIndexes + Indexes := self addNamespace + at: 'ReceiverIndex' put: 1; + at: 'ParentEnvironmentIndex' put: 2; + yourself +! ! + +!Closure class methodsFor: 'gs' stamp: 'KenD 28/Jun/2026 13:27:38'! +newFrom: aBlock + | size closure | + size := aBlock environmentCount + self instSize. + closure := self allocate: size * WordSize size: size. + closure _beNamed; _beArrayed. + self nil: size slotsOf: closure. + closure _basicAt: 1 put: aBlock. + ^closure +! ! + +!Closure class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiverIndex + ^ReceiverIndex +! ! + + diff --git a/modules/Kernel/Collection.Class.st b/modules/Kernel/Collection.Class.st new file mode 100644 index 00000000..472ef0a4 --- /dev/null +++ b/modules/Kernel/Collection.Class.st @@ -0,0 +1,514 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Collection category: #Kernel! +Object subclass: #Collection + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Collection commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Collection methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +& collection + ^CompositeCollection with: self with: collection +! ! + +!Collection methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +&& anObject + ^CompositeCollection with: self with: {anObject} +! ! + +!Collection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject + self subclassResponsibility +! ! + +!Collection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addAll: aCollection + aCollection do: [:element | self add: element]. + ^aCollection +! ! + +!Collection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +anyone + ^self detect: [:one | true] ifNone: nil +! ! + +!Collection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +anySatisfy: aBlock + self detect: aBlock ifNone: [^false]. + ^true +! ! + +!Collection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asArray + ^Array withAll: self +! ! + +!Collection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asBag + ^Bag withAll: self +! ! + +!Collection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asIdentitySet + ^IdentitySet withAll: self +! ! + +!Collection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asOrderedCollection + ^OrderedCollection withAll: self +! ! + +!Collection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asSet + ^Set withAll: self +! ! + +!Collection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asSortedCollection + ^SortedCollection withAll: self +! ! + +!Collection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asSortedCollection: aBlock + ^SortedCollection withAll: self sortingBy: aBlock +! ! + +!Collection methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicPrintOn: aStream + self disableCode: [Recursion + checkOn: self + while: [ + self class printOn: aStream. + aStream nextPut: $(. + self + do: [:element | element printOn: aStream] + separatedBy: [aStream space]. + aStream nextPut: $)] + onSignal: [:e | + aStream nextPutAll: e description. + ^self]]. + self class printOn: aStream. + aStream nextPut: $(. + self + do: [:element | element printOn: aStream] + separatedBy: [aStream space]. + aStream nextPut: $) +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: evaluable + | collector | + collector := self species new: self size. + ^self collect: evaluable in: collector +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: evaluable in: aCollection + self do: [:x | | fx | + fx := evaluable evaluateWith: x. + aCollection add: fx]. + ^aCollection +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: aBlock thenDetect: anotherBlock + self do: [:x | | fx | + fx := aBlock evaluateWith: x. + (anotherBlock evaluateWith: fx) ifTrue: [^fx]]. + ^nil +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: aBlock thenDo: anotherBlock + self do: [:x | | fx | + fx := aBlock evaluateWith: x. + anotherBlock evaluateWith: fx] +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: aBlock thenSelect: anotherBlock + | collector | + collector := self species new: self size. + ^self collect: aBlock thenSelect: anotherBlock in: collector +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: aBlock thenSelect: anotherBlock in: aCollection + self do: [:x | | fx | + fx := aBlock evaluateWith: x. + (anotherBlock evaluateWith: fx) ifTrue: [aCollection add: fx]]. + ^aCollection +! ! + +!Collection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +conform: evaluable + self + detect: [:x | | fx | + fx := evaluable evaluateWith: x. + fx not] + ifNone: [^true]. + ^false +! ! + +!Collection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyWith: anObject + ^self copy add: anObject; yourself +! ! + +!Collection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyWithout: anObject + ^self reject: [:element | element = anObject] +! ! + +!Collection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +count: evaluable + | count | + count := 0. + self select: evaluable thenDo: [:x | count := count + 1]. + ^count +! ! + +!Collection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + ^self collect: [:element | element copy] in: self species new +! ! + +!Collection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +detect: evaluable + ^self detect: evaluable ifNone: [self errorNotFound] +! ! + +!Collection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +detect: evaluable ifFound: aBlock + self detect: evaluable ifFound: aBlock ifNone: nil +! ! + +!Collection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +detect: aBlock ifFound: foundBlock ifNone: exceptionBlock + self do: [:element | | found | + found := aBlock evaluateWith: element. + found ifTrue: [^foundBlock evaluateWith: element]]. + ^exceptionBlock value +! ! + +!Collection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +detect: aBlock ifNone: anotherBlock + ^self detect: aBlock ifFound: [:element | element] ifNone: anotherBlock +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + self subclassResponsibility +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock separatedBy: separatorBlock + | separate | + separate := false. + self do: [:element | + separate ifTrue: [separatorBlock value] ifFalse: [separate := true]. + aBlock evaluateWith: element] +! ! + +!Collection methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +equalsTo: aCollection + self size = aCollection size ifFalse: [^false]. + aCollection do: [:element | (self includes: element) ifFalse: [^false]]. + self do: [:element | (aCollection includes: element) ifFalse: [^false]]. + ^true +! ! + +!Collection methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +errorNotFound + ^self error: 'object not found in the collection' +! ! + +!Collection methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +errorNotIndexable + ^self error: 'instances of ' , self class name , ' are not indexable' +! ! + +!Collection methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +errorNotKeyed + self + error: 'instances of ' , self class name + , ' do not respond to keyed accessing messages' +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +gather: aBlock + ^self gather: aBlock in: (OrderedCollection new: self size) +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +gather: aBlock in: collection + self do: [:each | | things | + things := aBlock evaluateWith: each. + collection addAll: things]. + ^collection +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +gather: aBlock thenSelect: anotherBlock in: aCollection + self do: [:each | | things | + things := aBlock evaluateWith: each. + things + do: [:element | (anotherBlock evaluateWith: element) + ifTrue: [aCollection add: element]]]. + ^aCollection +! ! + +!Collection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +includes: anObject + ^self anySatisfy: [:element | anObject = element] +! ! + +!Collection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +includesIdentical: anObject + self do: [:each | each == anObject ifTrue: [^true]]. + ^false +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +inject: anObject into: aBlock + | result | + result := anObject. + self do: [:element | result := aBlock value: result value: element]. + ^result +! ! + +!Collection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCollection + ^true +! ! + +!Collection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmpty + ^self size = 0 +! ! + +!Collection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmptyOrNil + ^self isEmpty +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +noneSatisfy: evaluable + self do: [:item | (evaluable evaluateWith: item) ifTrue: [^false]]. + ^true +! ! + +!Collection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +notEmpty + ^self isEmpty not +! ! + +!Collection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +occurrencesOf: anObject + | count | + count := 0. + self do: [:element | element = anObject ifTrue: [count := count + 1]]. + ^count +! ! + +!Collection methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printElementText: element on: rtf position: i + element printOn: rtf +! ! + +!Collection methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printLimit + ^4000 +! ! + +!Collection methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + self basicPrintOn: aStream +! ! + +!Collection methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream limit: aNumber + | limit | + Recursion + checkOn: self + while: [ + limit := aStream position + (aNumber ifNil: [Number infinity]). + self class printOn: aStream. + aStream nextPut: $(. + self + do: [:element | + aStream position > limit ifTrue: [ + '…etc…)' printOn: aStream. + ^self]. + element printOn: aStream] + separatedBy: [aStream space]. + aStream nextPut: $)] + onSignal: [:e | + aStream nextPutAll: e description. + ^self] +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +reject: aBlock + ^self select: [:x | (aBlock evaluateWith: x) not] +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +reject: aBlock thenDo: anotherBlock + self + do: [:each | (aBlock evaluateWith: each) + ifFalse: [anotherBlock evaluateWith: each]] +! ! + +!Collection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: anObject + ^self remove: anObject ifAbsent: [self errorNotFound] +! ! + +!Collection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: anObject ifAbsent: aBlock + self subclassResponsibility +! ! + +!Collection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAll + self isEmpty ifTrue: [^self]. + self copy do: [:x | self remove: x] +! ! + +!Collection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAll: aCollection + aCollection do: [:x | self remove: x]. + ^aCollection +! ! + +!Collection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAllSuchThat: aBlock + self copy do: [:each | (aBlock value: each) ifTrue: [self remove: each]] +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: aBlock + ^self select: aBlock in: self species new +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: evaluable in: aCollection + self select: evaluable thenDo: [:x | aCollection add: x]. + ^aCollection +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: aBlock thenCollect: anotherBlock + | collection | + collection := self species new. + self select: aBlock thenCollect: anotherBlock in: collection. + ^collection +! ! + +!Collection methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: aBlock thenCollect: anotherBlock in: aCollection + self select: aBlock thenDo: [:x | | fx | + fx := anotherBlock evaluateWith: x. + aCollection add: fx]. + ^aCollection +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: aBlock thenDo: anotherBlock + self + do: [:element | (aBlock evaluateWith: element) + ifTrue: [anotherBlock evaluateWith: element]] +! ! + +!Collection methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + Recursion checkOn: self while: [ + aStream + nextPut: $(; + nextPutAll: self class name; + nextPutAll: ' new'. + self do: [:x | + aStream nextPutAll: ' add: ('. + x storeOn: aStream. + aStream nextPutAll: ');']. + aStream nextPutAll: ' yourself'; nextPut: $)] +! ! + +!Collection methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +sum + ^self sum: [:x | x] ifNone: 0 +! ! + +!Collection methodsFor: 'functions' stamp: 'KenD 28/Jun/2026 13:27:38'! +sum: aBlock + ^self sum: aBlock ifNone: 0 +! ! + +!Collection methodsFor: 'functions' stamp: 'KenD 28/Jun/2026 13:27:38'! +sum: aBlock ifNone: exceptionBlock + | sum | + self do: [:each | | value | + value := aBlock evaluateWith: each. + value isUndefinedValue + ifFalse: [sum := sum == nil ifTrue: [value] ifFalse: [sum + value]]]. + ^sum isUndefinedValue ifTrue: [exceptionBlock value] ifFalse: [sum] +! ! + +!Collection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withoutDuplicates + | visited | + visited := Set new. + ^self select: [:element | | found | + found := visited includes: element. + found ifFalse: [visited add: element]. + found not] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Collection class' category: #Kernel! +Collection class + instanceVariableNames: ''! + +!Collection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: anObject + ^self new add: anObject; yourself +! ! + +!Collection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: object1 with: object2 + ^self new add: object1; add: object2; yourself +! ! + +!Collection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: object1 with: object2 with: object3 + ^self new + add: object1; + add: object2; + add: object3; + yourself +! ! + +!Collection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: object1 with: object2 with: object3 with: object4 + ^self new + add: object1; + add: object2; + add: object3; + add: object4; + yourself +! ! + +!Collection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: anObject withAll: aCollection + ^self new add: anObject; addAll: aCollection; yourself +! ! + + diff --git a/modules/Kernel/CommandLine.Class.st b/modules/Kernel/CommandLine.Class.st new file mode 100644 index 00000000..b4b01102 --- /dev/null +++ b/modules/Kernel/CommandLine.Class.st @@ -0,0 +1,274 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #CommandLine category: #Kernel! +Object subclass: #CommandLine + instanceVariableNames: 'input rules tokens command options' + classVariableNames: '' + poolDictionaries: 'CharacterConstants' + category: 'Kernel'! +!CommandLine commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!CommandLine methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +actionFor: option + ^rules at: option ifAbsent: nil +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +addOption: option + ^self addOption: option with: #() +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +addOption: option with: arguments + | op args | + op := self canonize: option. + args := (arguments isCollection andNot: [arguments isString]) + ifTrue: [arguments asArray] + ifFalse: [{arguments}]. + args := args collect: #asString. + ^options at: op put: args +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +argumentAt: option + | arguments | + arguments := self argumentsAt: option. + arguments ifNil: [^nil]. + ^arguments size = 1 + ifTrue: [arguments first] + ifFalse: [self error: 'The option has a different number of arguments'] +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +argumentsAt: option + | op | + op := self canonize: option. + ^options at: op ifAbsent: nil +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +booleanAt: option + | arguments value | + arguments := self argumentsAt: option. + arguments ifNil: [^false]. + arguments size = 0 ifTrue: [^true]. + arguments size = 1 ifTrue: [ + value := arguments first. + ^(value = '0' or: [value = 'false' or: [value = 'no']]) not]. + self error: 'The option has a different number of arguments' +! ! + +!CommandLine methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +canonize: option + ^(((option trimPrefix: '--') trimPrefix: '-') trimTail: ':') trimTail: '=' +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +command + ^command +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +command: aString + command := aString +! ! + +!CommandLine methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +formatArgument: argument + ^(argument includes: Space) + ifTrue: [argument doubleQuoted] + ifFalse: [argument] +! ! + +!CommandLine methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +formatOption: option + | prefix string | + prefix := option size = 1 ifTrue: ['-'] ifFalse: ['--']. + string := (option includes: Space) + ifTrue: [option doubleQuoted] + ifFalse: [option]. + ^prefix , string +! ! + +!CommandLine methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString + self on: aString; parse +! ! + +!CommandLine methodsFor: 'processing' stamp: 'KenD 28/Jun/2026 13:27:38'! +getArguments: anInteger for: option + | args | + args := self nextTokens: anInteger. + args size < anInteger ifTrue: [ + args := anInteger = 1 ifTrue: [' argument'] ifFalse: [' arguments']. + self error: 'Option ' , option , ' expects ' , anInteger asString , args]. + ^args +! ! + +!CommandLine methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +includesOption: aString + | option | + option := self canonize: aString. + ^options includesKey: option +! ! + +!CommandLine methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + options := OrderedDictionary new. + rules := OrderedDictionary new +! ! + +!CommandLine methodsFor: 'processing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextArgumentTokens + ^tokens untilAnySatisfying: [:t | self seemsOption: t] +! ! + +!CommandLine methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextToken + ^tokens next +! ! + +!CommandLine methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextTokens: anInteger + | max | + max := anInteger min: tokens size - tokens position. + ^(tokens next: max) asArray +! ! + +!CommandLine methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aString + input := aString +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +options + ^options keys +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +parameters + ^self options +! ! + +!CommandLine methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +parse + self tokenize +! ! + +!CommandLine methodsFor: 'processing' stamp: 'KenD 28/Jun/2026 13:27:38'! +process + tokens isNil ifTrue: [self parse]. + tokens := tokens readStream. + command := tokens next. + [tokens atEnd] whileFalse: [| option arguments token | + token := self nextToken. + (self seemsOption: token) ifTrue: [self processOption: token] ifFalse: [ + option := self canonize: token. + arguments := self nextArgumentTokens. + self addOption: option with: arguments]] +! ! + +!CommandLine methodsFor: 'processing' stamp: 'KenD 28/Jun/2026 13:27:38'! +processOption: token + | action option | + option := self canonize: token. + action := self actionFor: option. + (action isNil and: [self seemsMultipleOption: token]) + ifTrue: [option do: [:char | self processOption: char asString]] + ifFalse: [self processOption: option action: action] +! ! + +!CommandLine methodsFor: 'processing' stamp: 'KenD 28/Jun/2026 13:27:38'! +processOption: option action: action + | arguments | + arguments := action notNil + ifTrue: [self getArguments: action arity for: option] + ifFalse: [self nextArgumentTokens]. + action notNil ifTrue: [action evaluateWithArguments: arguments]. + self addOption: option with: arguments +! ! + +!CommandLine methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +readTokenFrom: aStream + ^String streamContents: [:strm | | next end t | + next := aStream next. + end := next = $" ifTrue: [$"] ifFalse: [ + strm nextPut: next. + Space]. + t := aStream upTo: end. + strm nextPutAll: t] +! ! + +!CommandLine methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reset + command := tokens := nil. + options removeAll +! ! + +!CommandLine methodsFor: 'processing' stamp: 'KenD 28/Jun/2026 13:27:38'! +seemsMultipleOption: token + | option | + (token beginsWith: '--') ifTrue: [^false]. + option := self canonize: token. + ^option size > 1 + and: [option conform: [:char | rules includesKey: char asString]] +! ! + +!CommandLine methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +seemsOption: aString + ^aString first = $- +! ! + +!CommandLine methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tokenize + | stream | + tokens := OrderedCollection new. + stream := input readStream. + [stream skipSeparators; atEnd] whileFalse: [| token | + token := self readTokenFrom: stream. + tokens add: token] +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +withOption: aString do: aBlock + | option | + option := self canonize: aString. + rules at: option put: aBlock. + self reset +! ! + +!CommandLine methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +withOption: short or: long do: aBlock + | s l | + s := self canonize: short. + l := self canonize: long. + rules + at: s put: aBlock; + at: l put: aBlock. + self reset +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CommandLine class' category: #Kernel! +CommandLine class + instanceVariableNames: ''! + +!CommandLine class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString + ^self new fromString: aString; process +! ! + +!CommandLine class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aString + ^self new on: aString +! ! + + +CommandLine initialize! + diff --git a/modules/Kernel/CompiledBlock.Class.st b/modules/Kernel/CompiledBlock.Class.st new file mode 100644 index 00000000..c976a7ae --- /dev/null +++ b/modules/Kernel/CompiledBlock.Class.st @@ -0,0 +1,320 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #CompiledBlock category: #Kernel! +Object subclass: #CompiledBlock + instanceVariableNames: 'format optimizedCode method' + classVariableNames: 'Flags' + poolDictionaries: '' + category: 'Kernel'! +!CompiledBlock commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2020 LabWare. + See (MIT) license in root directory. +! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +argumentCount + ^format bitsAt: ArgCount +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +argumentCount: anInteger + format := format bitsAt: ArgCount put: anInteger +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +arity + ^self argumentCount +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +aspects + ^#(#arity + #blockNumber + #method + #hasMethodEnvironment + #tempCount + #templateIndex) +! ! + +!CompiledBlock methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicPrintOn: aStream + method printOn: aStream. + aStream + nextPutAll: '. Block number: '; + nextPutAll: self blockNumber printString; + nextPutAll: ', '; + nextPutAll: self argumentCount printString; + nextPutAll: ' args, '; + nextPutAll: self tempCount printString; + nextPutAll: ' temps. ' +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bindMethod: aCompiledMethod + method := aCompiledMethod +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +blockCode + ^optimizedCode code +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +blockExecutableCode + " + required to let the optimizing compiler inline this code + without confusing with CompiledMethod>>#executableCode + " + ^optimizedCode +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +blockOptimizedCode + " + required to let the optimizing compiler inline this code + without confusing with CompiledMethod>>#optimizedCode + " + ^optimizedCode +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +blockNumber + ^format bitsAt: Id +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +blockNumber: anInteger + format := format bitsAt: Id put: anInteger +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +capturesHome: aBoolean + format := aBoolean + ifTrue: [ format bitOr: CapturesHome ] + ifFalse: [ format bitClear: CapturesHome ] +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +capturesSelf: aBoolean + format := aBoolean + ifTrue: [ format bitOr: CapturesSelf ] + ifFalse: [ format bitClear: CapturesSelf ] +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +environmentCount + ^format bitsAt: EnvCount +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +environmentCount: anInteger + format := format bitsAt: EnvCount put: anInteger +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +format + ^format +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +format: anInteger + format := anInteger +! ! + +!CompiledBlock methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasMethodEnvironment + ^self size >= 2 and: [(self at: 2) notNil] +! ! + +!CompiledBlock methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasReceiver + | index | + index := Closure receiverIndex. + ^self size >= index andNot: [(self at: index) isNil] +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + format := 0 +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +invalidateOptimizedCode + optimizedCode := nil +! ! + +!CompiledBlock methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBlock + ^true +! ! + +!CompiledBlock methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCallback + ^method isCallback +! ! + +!CompiledBlock methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDebuggable + ^method isDebuggable +! ! + +!CompiledBlock methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +loadFrom: anArray + method := anArray at: 1. + format := anArray at: 2. + 3 to: anArray size do: [:i | | ai | + ai := anArray at: i. + self at: i - 2 put: ai] +! ! + +!CompiledBlock methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxArity + ^(1 bitShift: ArgCount length) - 1 +! ! + +!CompiledBlock methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxBlockNumber + ^(1 bitShift: Id length) - 1 +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +method + ^method +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +method: aCompiledMethod + method := aCompiledMethod +! ! + +!CompiledBlock methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +newClosure + ^Closure newFrom: self +! ! + +!CompiledBlock methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +optimizedCode + ^optimizedCode +! ! + +!CompiledBlock methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +optimizedCode: anObject + anObject block: self. + optimizedCode := anObject +! ! + +!CompiledBlock methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + self class printOn: aStream. + aStream nextPut: $(. + self basicPrintOn: aStream. + (1 to: self size) + do: [:i | | field tag rest | + field := self at: i. + field ifNil: [aStream nextPutAll: 'nil'] ifNotNil: [ + tag := field bitShift: -27. + rest := field bitAnd: 16r7FFFFFF. + aStream + nextPut: $[; + nextPutAll: tag asString; + space; + nextPutAll: rest asString; + nextPut: $]]] + separatedBy: [aStream space]. + aStream nextPut: $) +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tempCount + ^format bitsAt: TempCount +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tempCount: anInteger + format := format bitsAt: TempCount put: anInteger +! ! + +!CompiledBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +templateIndex + | n | + n := self blockNumber. + ^method literals + findFirst: [:literal | literal isBlock and: [literal blockNumber = n]] + ifAbsent: [self ASSERT: false] +! ! + +!CompiledBlock methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +temporaryLimit + ^(1 bitShift: TempCount length) - 1 +! ! + +!CompiledBlock methodsFor: 'isEvaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueSelector + | arity | + arity := self arity. + arity = 0 ifTrue: [^#value]. + arity = 1 ifTrue: [^#value:]. + arity = 2 ifTrue: [^#value:value:]. + arity = 3 ifTrue: [^#value:value:value:]. + arity = 4 ifTrue: [^#value:value:value:value:]. + self ASSERT: false. + ^#valueWithArguments: +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CompiledBlock class' category: #Kernel! +CompiledBlock class + instanceVariableNames: 'Flags'! + +!CompiledBlock class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +ensureFormatCorrectness + self + ASSERT: Id end <= SmallInteger maximum; + ASSERT: ArgCount end <= SmallInteger maximum; + ASSERT: TempCount end <= SmallInteger maximum; + DENY: (Id intersects: ArgCount); + DENY: (Id intersects: TempCount); + DENY: (ArgCount intersects: TempCount) +! ! + +!CompiledBlock class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromArray: anArray + | block | + block := self new: anArray size - 2. + ^block loadFrom: anArray +! ! + +!CompiledBlock class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeFormatFlags + " + self initializeFormatFlags. + self compileAll. + self class compileAll + " + Flags := self addNamespace + at: #ArgCount put: (1 thru: 6); + at: #TempCount put: (7 thru: 14); + at: #Id put: (15 thru: 22); + at: #CapturesSelf put: (1 bitShift: 23 - 1); + at: #CapturesHome put: (1 bitShift: 24 - 1); + at: #EnvCount put: (25 thru: 31); + yourself. +! ! + +!CompiledBlock class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxArgCount + ^(2 raisedTo: ArgCount length) - 1 +! ! + +!CompiledBlock class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxTempCount + ^(2 raisedTo: TempCount length) - 1 +! ! + + +CompiledBlock initialize! + diff --git a/modules/Kernel/CompiledExpression.Class.st b/modules/Kernel/CompiledExpression.Class.st new file mode 100644 index 00000000..5a9afca6 --- /dev/null +++ b/modules/Kernel/CompiledExpression.Class.st @@ -0,0 +1,46 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #CompiledExpression category: #Kernel! +CompiledMethod subclass: #CompiledExpression + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!CompiledExpression commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!CompiledExpression methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +currentVersion + ^self +! ! + +!CompiledExpression methodsFor: 'evaluation' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluate + ^self executeOn: nil +! ! + +!CompiledExpression methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDoit + ^self selector == #doit +! ! + +!CompiledExpression methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isExpression + ^true +! ! + +!CompiledExpression methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +selector + ^selector ifNil: [#doit] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CompiledExpression class' category: #Kernel! +CompiledExpression class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/CompiledMethod.Class.st b/modules/Kernel/CompiledMethod.Class.st new file mode 100644 index 00000000..9f3ec0a0 --- /dev/null +++ b/modules/Kernel/CompiledMethod.Class.st @@ -0,0 +1,498 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #CompiledMethod category: #Kernel! +Array subclass: #CompiledMethod + instanceVariableNames: 'format optimizedCode treecodes class selector source' + classVariableNames: 'Flags' + poolDictionaries: '' + category: 'Kernel'! +!CompiledMethod commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2020 LabWare. + See (MIT) license in root directory. +! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +author + ^'Unknown' +! ! + +!CompiledMethod methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +~ aCompiledMethod + self literals = aCompiledMethod literals ifFalse: [^false]. + ^treecodes = aCompiledMethod treecodes +! ! + +!CompiledMethod methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += anObject + ^self == anObject +! ! + +!CompiledMethod methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +addSymbolsIn: anArray to: aSet + anArray do: [:elem | + elem isSymbol + ifTrue: [aSet add: elem] + ifFalse: [elem class == Array ifTrue: [self addSymbolsIn: elem to: aSet]]] +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +argumentCount + ^format bitsAt: ArgCount +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +argumentCount: anInteger + format := format bitsAt: ArgCount put: anInteger +! ! + +!CompiledMethod methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +asExtensionFor: aModule + "Note: keep in mind that this service breaks the relationship between the receiver and its blocks." + | extension | + extension := self class withAll: self literals , {#module -> aModule}. + extension + format: format; + beExtension; + selector: selector; + sourceObject: source; + classBinding: class; + treecodes: treecodes. + extension blocks do: [:block | block method: extension]. + ^extension +! ! + +!CompiledMethod methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asOverridden + ^self +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +beExtension + format := format bitOr: IsExtension +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +blockCount + ^format bitsAt: BlockCount +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +blockCount: anInteger + format := format bitsAt: BlockCount put: anInteger +! ! + +!CompiledMethod methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +blocks + self hasBlocks ifFalse: [^#()]. + ^self select: [:literal | literal isBlock] +! ! + +!CompiledMethod methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +blocksDo: aBlock + self hasBlocks ifFalse: [^self]. + self + select: [:b | b isBlock and: [b method == self]] + thenDo: [:b | aBlock evaluateWith: b] +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +treecodes + ^treecodes +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +treecodes: aByteArray + treecodes := aByteArray +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBeInstalled + ^self isExpression not +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +capturesSelf + ^format isOnBit: CapturesSelf +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +capturesSelf: aBoolean + format := aBoolean + ifTrue: [ format bitOr: CapturesSelf ] + ifFalse: [ format bitClear: CapturesSelf ] +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +category + ^class categoryFor: selector +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +category: category + ^class organization move: selector to: category +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classBinding + ^class +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classBinding: aClass + class := aClass +! ! + +!CompiledMethod methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +currentVersion + ^class compiledMethodAt: selector +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +environmentCount + ^format bitsAt: EnvCount +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +environmentCount: anInteger + format bitsAt: EnvCount put: anInteger +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +executableCode + ^optimizedCode +! ! + +!CompiledMethod methodsFor: 'evaluation' stamp: 'KenD 28/Jun/2026 13:27:38'! +executeOn: receiver withArguments: anArray + | size | + self prepareForExecution. + size := anArray basicSize. + self argumentCount = size ifFalse: [^self error: 'incorrect arity']. + anArray _expandInStackSized: size. + ^receiver _invoke: self validOptimizedCodeAddress _asNative +! ! + +!CompiledMethod methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +flushFromCaches + self errorVMSpecific +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +format + ^format +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +format: anInteger + format := anInteger +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasBlocks + ^self blockCount > 0 +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasEnvironment: aBoolean + format := aBoolean + ifTrue: [ format bitOr: HasEnvironment ] + ifFalse: [ format bitClear: HasEnvironment ] +! ! + +!CompiledMethod methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasEnvironment + ^self environmentCount > 0 +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasFrame + ^format isOnBit: HasFrame +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasFrame: aBoolean + format := aBoolean + ifTrue: [ format bitOr: HasFrame ] + ifFalse: [ format bitClear: HasFrame ] +! ! + +!CompiledMethod methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^selector hashWith: class +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasOptimizedCode + ^optimizedCode !!= nil +! ! + +!CompiledMethod methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + format := 0 +! ! + +!CompiledMethod methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! +install + class addSelector: selector withMethod: self +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +invalidateOptimizedCode + optimizedCode ifNil: [^self]. + optimizedCode := nil. + self blocksDo: [:b | b invalidateOptimizedCode] +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCallback + ^false +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCompiledMethod + ^true +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCurrentVersion + ^class notNil and: [self == (class compiledMethodAt: selector)] +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDebuggable + ^format isOnBit: Debuggable +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDoit + ^false +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isExpression + ^false +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isExtension + ^format isOnBit: IsExtension +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCalloutMethod + ^false +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFrameless + ^self hasFrame not +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFFIMethod + ^false +! ! + +!CompiledMethod methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +isNativized + ^false == (optimizedCode == nil) +! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isOverridden + ^false +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +literalIndexFrom: grossIndex + | instVars index | + grossIndex _isSmallInteger ifFalse: [^self outOfBoundsIndex: grossIndex]. + instVars := self class instSize. + (1 <= grossIndex and: [grossIndex <= (self _size - instVars)]) + ifFalse: [^self outOfBoundsIndex: grossIndex]. + index := grossIndex + instVars. + ^index +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +literals + ^Array withAll: self +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +method + ^self +! ! + +!CompiledMethod methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +module + | association | + self isExtension ifFalse: [^class module]. + association := self last. + (association isAssociation and: [association key == #module]) + ifFalse: [self error: 'extension method ', self signature , ' without module']. + ^association value +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +optimizedCode + ^optimizedCode +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +optimizedCode: anObject + anObject method: self. + optimizedCode := anObject +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +optimizedCodeAddress + self prepareForExecution. + ^optimizedCode optimizedCodeAddress +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +pragma: aPragmaNode + +! ! + +!CompiledMethod methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +postCopy + super postCopy. + self + withIndexDo: [:b :i | | c | + b isBlock ifTrue: [ + c := b copy method: self. + self at: i put: c]]; + invalidateOptimizedCode +! ! + +!CompiledMethod methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +prepareForExecution + self isNativized ifFalse: [Kernel prepareForExecution: self]. +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNumber + ^0 +! ! + +!CompiledMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream + print: class; + nextPutAll: '>>'; + print: selector +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +selector + ^selector +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +selector: aSymbol + selector := aSymbol. + optimizedCode notNil ifTrue: [self invalidateOptimizedCode; nativize] +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +selectorAt: index + ^self at: self size - index + 1 +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sendSites + ^optimizedCode sendSites +! ! + +!CompiledMethod methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +signature + ^class -> selector +! ! + +!CompiledMethod methodsFor: 'source code support' stamp: 'KenD 28/Jun/2026 13:27:38'! +sourceObject + ^source +! ! + +!CompiledMethod methodsFor: 'source code support' stamp: 'KenD 28/Jun/2026 13:27:38'! +sourceObject: aString + source := aString +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tempCount + ^format bitsAt: TempCount +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tempCount: anInteger + format := format bitsAt: TempCount put: anInteger +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +timestamp + ^nil +! ! + +!CompiledMethod methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +updateOptimizedCode + optimizedCode ifNil: [^self]. + self invalidateOptimizedCode; prepareForExecution +! ! + +!CompiledMethod methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +validOptimizedCodeAddress + ^optimizedCode code _asSmallInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CompiledMethod class' category: #Kernel! +CompiledMethod class + instanceVariableNames: 'Flags'! + +!CompiledMethod class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeFormatFlags + Flags := self addNamespace. + Flags + at: #ArgCount put: (1 thru: 6); + at: #BlockCount put: (7 thru: 13); + at: #TempCount put: (14 thru: 21); + at: #CapturesSelf put: (1 bitShift: 22 - 1); + at: #HasEnvironment put: (1 bitShift: 23 - 1); + at: #HasFrame put: (1 bitShift: 24 - 1); + at: #Debuggable put: (1 bitShift: 25 - 1); + at: #EnvCount put: (26 thru: 31); + at: #IsExtension put: (1 bitShift: 32 - 1) +! ! + +!CompiledMethod class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxArgCount + ^(2 raisedTo: ArgCount length) - 1 +! ! + +!CompiledMethod class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxBlockCount + ^(2 raisedTo: BlockCount length) - 1 +! ! + +!CompiledMethod class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxTempCount + ^(2 raisedTo: TempCount length) - 1 +! ! + +!CompiledMethod class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + | cm | + cm := super new: anInteger. + ^cm initialize +! ! + + +CompiledMethod initialize! + diff --git a/modules/Kernel/CompositeCollection.Class.st b/modules/Kernel/CompositeCollection.Class.st new file mode 100644 index 00000000..0ec6ba45 --- /dev/null +++ b/modules/Kernel/CompositeCollection.Class.st @@ -0,0 +1,255 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #CompositeCollection category: #Kernel! +Collection subclass: #CompositeCollection + instanceVariableNames: 'contents' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!CompositeCollection commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!CompositeCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +& collection + collection class == self class + ifTrue: [collection addTo: self] + ifFalse: [self add: collection] +! ! + +!CompositeCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +&& anObject + contents add: {anObject} +! ! + +!CompositeCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject + anObject isEmpty ifFalse: [contents add: anObject] +! ! + +!CompositeCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addAll: aCollection + self & aCollection +! ! + +!CompositeCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addTo: aCompositeCollection + contents do: [:c | aCompositeCollection add: c] +! ! + +!CompositeCollection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asOrderedCollection + | collection | + collection := OrderedCollection new: self size. + contents do: [:c | collection addAll: c]. + ^collection +! ! + +!CompositeCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + ^self at: index ifAbsent: [self error: 'Invalid index'] +! ! + +!CompositeCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index ifAbsent: aBlock + | s end | + s := 0. + contents do: [:collection | + end := s + collection size. + index <= end ifTrue: [^collection at: index - s]. + s := end]. + ^aBlock value +! ! + +!CompositeCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +contents + ^contents +! ! + +!CompositeCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyFrom: start to: stop + | size copy | + size := stop - start + 1 max: 0. + copy := self species new: size. + self withIndexDo: [:e :i | + i >= start ifTrue: [copy add: e]. + i = stop ifTrue: [^copy]]. + ^copy +! ! + +!CompositeCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyWithout: anObject + | copy | + copy := contents collect: [:c | c copyWithout: anObject]. + ^self class withAll: copy +! ! + +!CompositeCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + contents do: [:each | each do: aBlock] +! ! + +!CompositeCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +findFirst: aBlock ifAbsent: errorBlock + self withIndexDo: [:ai :i | (aBlock evaluateWith: ai) ifTrue: [^i]]. + ^errorBlock value +! ! + +!CompositeCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +first + ^self at: 1 +! ! + +!CompositeCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: anObject + ^self indexOf: anObject ifAbsent: 0 +! ! + +!CompositeCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: anObject ifAbsent: aBlock + self withIndexDo: [:o :i | o = anObject ifTrue: [^i]]. + ^aBlock value +! ! + +!CompositeCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfIdentical: anObject + ^self indexOfIdentical: anObject ifAbsent: 0 +! ! + +!CompositeCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfIdentical: anObject ifAbsent: aBlock + self withIndexDo: [:o :i | o = anObject ifTrue: [^i]]. + ^aBlock value +! ! + +!CompositeCollection methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + contents := OrderedCollection new +! ! + +!CompositeCollection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmpty + contents isEmpty ifTrue: [^true]. + contents do: [:c | c isEmpty ifFalse: [^false]]. + ^true +! ! + +!CompositeCollection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSequenceableCollection + ^contents conform: [:collection | collection isSequenceableCollection] +! ! + +!CompositeCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +last + ^(contents notEmpty and: [contents last notEmpty]) + ifTrue: [contents last last] + ifFalse: [self at: self size] +! ! + +!CompositeCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +owningResource + ^nil +! ! + +!CompositeCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +postCopy + super postCopy. + contents := contents copy +! ! + +!CompositeCollection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +readStream + ^InternalReadStream on: self +! ! + +!CompositeCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: anObject + | index | + index := contents findFirst: [:c | c == anObject] ifAbsent: [| continue | + continue := Object new. + contents withIndexDo: [:c :i | | answer | + answer := c remove: anObject ifAbsent: continue. + answer == continue ifFalse: [ + c isEmpty ifTrue: [contents removeIndex: i]. + ^answer]]. + self errorNotFound]. + contents removeIndex: index. + ^anObject +! ! + +!CompositeCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +reverseDo: aBlock + contents reverseDo: [:each | each reverseDo: aBlock] +! ! + +!CompositeCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +second + ^self at: 2 +! ! + +!CompositeCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^contents sum: [:c | c size] ifNone: [0] +! ! + +!CompositeCollection methodsFor: 'organizing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sortBy: aBlock + ^self asOrderedCollection sortBy: aBlock +! ! + +!CompositeCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +species + ^OrderedCollection +! ! + +!CompositeCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aCollection do: aBlock + self + with: aCollection + withIndexDo: [:e1 :e2 :i | aBlock value: e1 value: e2] +! ! + +!CompositeCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aCollection withIndexDo: aBlock + self ASSERT: self isSequenceableCollection. + aCollection size = self size + ifFalse: [self error: 'both collections must have the same size']. + self + withIndexDo: [:each :index | aBlock + value: each + value: (aCollection at: index) + value: index] +! ! + +!CompositeCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: collection + contents := collection +! ! + +!CompositeCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withIndexDo: aBlock + | i | + self ASSERT: self isSequenceableCollection. + i := 1. + self do: [:each | + aBlock value: each value: i. + i := i + 1] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CompositeCollection class' category: #Kernel! +CompositeCollection class + instanceVariableNames: ''! + +!CompositeCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: collection + ^self new withAll: collection +! ! + + +CompositeCollection initialize! + diff --git a/modules/Kernel/Context.Class.st b/modules/Kernel/Context.Class.st new file mode 100644 index 00000000..2646dbb4 --- /dev/null +++ b/modules/Kernel/Context.Class.st @@ -0,0 +1,150 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Context category: #Kernel! +Object subclass: #Context + instanceVariableNames: 'caller callee code pc receiver stack environment' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Context commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +arguments + size := code argumentCount. + size = 0 ifTrue: [^#()]. + ^caller stackTop: size +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +callee + ^callee +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +callee: aContext + callee := aContext +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +caller + ^caller +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +caller: aContext + caller := aContext +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +code + ^code +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +code: anExecutableCode method: aCompiledMethod + | temps | +" code := anExecutableCode." + code := aCompiledMethod. + temps := aCompiledMethod tempCount. + stack := OrderedCollection new: temps + 5. + stack stretchTo: temps. + aCompiledMethod hasEnvironment + ifTrue: [environment := Array new: aCompiledMethod environmentCount]. + pc := 0. +! ! + +!Context methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyAllTo: aProcessStack + | start | + start := caller copyAllTo: aProcessStack. + ^self copyTo: aProcessStack at: start +! ! + +!Context methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyEnvironmentTo: aProcessStack at: start + "environment ifNil: [^2]." + aProcessStack + at: start - 2 put: self previousEnvironment; + at: start - 3 put: environment. + ^4 +! ! + +!Context methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyTo: aProcessStack at: start + | delta | + aProcessStack + at: start put: receiver; + at: start - 1 put: code. + + delta := self copyEnvironmentTo: aProcessStack at: start. + + stack do: [:temp | + aProcessStack at: start - delta put: temp. + delta := delta + 1 ]. + + aProcessStack + pcAt: start - delta put: pc of: code; + bpAt: start - delta - 1 put: start + 1. + + ^start - delta - 2 +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +environment + ^environment +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +environment: anObject + "The environment can be either nil (default), an array or a closure" + environment := anObject +! ! + +!Context methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +lastEnvironment + "environment ifNotNil: [^environment]. + ^caller ifNotNil: [caller lastEnvironment]" + ^environment +! ! + +!Context methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +previousEnvironment + ^caller lastEnvironment +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject + receiver := anObject +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +stack + ^stack +! ! + +!Context methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +stackTop: anInteger + ^stack last: anInteger +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tempAt: anInteger + ^stack at: anInteger +! ! + +!Context methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tempAt: anInteger put: anObject + ^stack at: anInteger put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Context class' category: #Kernel! +Context class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/Date.Class.st b/modules/Kernel/Date.Class.st new file mode 100644 index 00000000..493a3b94 --- /dev/null +++ b/modules/Kernel/Date.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Date category: #Kernel! +Magnitude subclass: #Date + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Date commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Date class' category: #Kernel! +Date class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/Delay.Class.st b/modules/Kernel/Delay.Class.st new file mode 100644 index 00000000..10768f7e --- /dev/null +++ b/modules/Kernel/Delay.Class.st @@ -0,0 +1,101 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Delay category: #Kernel! +Object subclass: #Delay + instanceVariableNames: 'milliseconds wait timer' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Delay commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Delay methodsFor: 'delaying' stamp: 'KenD 28/Jun/2026 13:27:38'! +cancel + timer notNil ifTrue: [timer stop]. + wait := nil +! ! + +!Delay methodsFor: 'delaying' stamp: 'KenD 28/Jun/2026 13:27:38'! +initTimer + timer notNil ifTrue: [timer stop]. + timer := Timer milliseconds: milliseconds. + timer when: #tick do: [ + timer stop. + self resume] +! ! + +!Delay methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWaiting + wait isNil ifTrue: [^false]. + ^wait isSignaled not +! ! + +!Delay methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +milliseconds: n + milliseconds := n +! ! + +!Delay methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + 'Delay of ' printOn: aStream. + milliseconds printOn: aStream. + ' milliseconds' printOn: aStream +! ! + +!Delay methodsFor: 'delaying' stamp: 'KenD 28/Jun/2026 13:27:38'! +resume + wait notNil ifTrue: [wait signal] +! ! + +!Delay methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +seconds: n + milliseconds := n * 1000 +! ! + +!Delay methodsFor: 'delaying' stamp: 'KenD 28/Jun/2026 13:27:38'! +wait + Processor activeProcess canBeSuspended + ifFalse: [^self error: 'The process can not be suspended at this time']. + wait := Semaphore new. + self initTimer. + timer start. + wait wait. + self cancel +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Delay class' category: #Kernel! +Delay class + instanceVariableNames: ''! + +!Delay class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +forMilliseconds: n + " + Delay forMilliseconds: 5000 + " + ^self new milliseconds: n +! ! + +!Delay class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +forSeconds: n + " + (Delay forSeconds: 3) wait. 7 inspect + " + ^self new seconds: n +! ! + +!Delay class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +wait: milliseconds + (Delay forMilliseconds: milliseconds) wait +! ! + +!Delay class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +waitSeconds: seconds + (Delay forSeconds: seconds) wait +! ! + + diff --git a/modules/Kernel/DeletedClass.Class.st b/modules/Kernel/DeletedClass.Class.st new file mode 100644 index 00000000..4f137d5e --- /dev/null +++ b/modules/Kernel/DeletedClass.Class.st @@ -0,0 +1,39 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #DeletedClass category: #Kernel! +Class subclass: #DeletedClass + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!DeletedClass commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!DeletedClass methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +beDeleted + " + Do nothing + " + +! ! + +!DeletedClass methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDeleted + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'DeletedClass class' category: #Kernel! +DeletedClass class + instanceVariableNames: ''! + +!DeletedClass class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBeDeleted + ^false +! ! + + diff --git a/modules/Kernel/Dictionary.Class.st b/modules/Kernel/Dictionary.Class.st new file mode 100644 index 00000000..e23e7725 --- /dev/null +++ b/modules/Kernel/Dictionary.Class.st @@ -0,0 +1,396 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Dictionary category: #Kernel! +HashedCollection subclass: #Dictionary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Dictionary commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Dictionary methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aCollection + self == aCollection ifTrue: [^true]. + self class = aCollection class ifFalse: [^false]. + self size = aCollection size ifFalse: [^false]. + self keysAndValuesDo: [:k :v | | w | + w := aCollection at: k ifAbsent: [^false]. + v = w ifFalse: [^false]]. + ^true +! ! + +!Dictionary methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anAssociation + ^self basicAdd: anAssociation +! ! + +!Dictionary methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addAll: aCollection + aCollection isDictionary + ifTrue: [aCollection associationsDo: [:assoc | self add: assoc]] + ifFalse: [aCollection do: [:assoc | self add: assoc]]. + ^aCollection +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +anyone + self associationsDo: [:assoc | ^assoc value]. + ^nil +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationAt: key + ^self associationAt: key ifAbsent: [self keyNotFound: key] +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationAt: key ifAbsent: aBlock + | assoc | + assoc := table lookupKey: key. + ^assoc isNil ifTrue: [aBlock value] ifFalse: [assoc] +! ! + +!Dictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationClass + ^Association +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +associations + ^Array + streamContents: [:strm | self associationsDo: [:a | strm nextPut: a]] +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationsDo: aBlock + table elementsDo: aBlock count: self size +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationsSelect: aBlock + | selection | + selection := self species new. + self + associationsDo: [:assoc | (aBlock evaluateWith: assoc) + ifTrue: [selection add: assoc]]. + ^selection +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: key + ^table lookupValue: key +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: key ifAbsent: aBlock + ^table lookupValue: key ifAbsent: aBlock +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: key ifAbsent: aBlock ifPresent: pBlock + ^table lookUpValue: key ifAbsent: aBlock ifPresent: pBlock +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: key ifAbsentPut: aBlock + ^self at: key ifAbsent: [self at: key put: aBlock value] +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: key ifPresent: aBlock + ^table lookupValue: key ifPresent: aBlock +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: key put: element + | assoc | + assoc := self associationClass key: key value: element. + self add: assoc. + ^element +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: key put: anObject ifPresent: aBlock + | assoc existing answer | + assoc := self associationClass key: key value: anObject. + existing := table atKey: key put: assoc. + existing isNil + ifTrue: [ + self incrementTally. + answer := anObject] + ifFalse: [ + answer := aBlock value: existing value. + existing value: answer]. + ^answer +! ! + +!Dictionary methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: key sum: aNumber + | prev | + prev := table atKey: key sum: aNumber. + ^prev isNil + ifTrue: [ + self incrementTally. + aNumber] + ifFalse: [self storesAssociations ifTrue: [prev value] ifFalse: [prev]] +! ! + +!Dictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAdd: anAssociation + | assoc | + assoc := table atKey: anAssociation key put: anAssociation. + assoc == nil + ifTrue: [self incrementTally] + ifFalse: [assoc value: anAssociation value]. + ^anAssociation +! ! + +!Dictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: key put: element for: aDictionary + table basicAtKey: key put: element. + tally := tally + 1 +! ! + +!Dictionary methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicRemoveKey: key ifAbsent: aBlock + table removeKey: key ifAbsent: [^aBlock value]. + tally := tally - 1. + ^key +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: aBlock + | answer | + answer := self species new: self size. + self keysAndValuesDo: [:key :value | + answer + add: (answer associationClass key: key value: (aBlock evaluateWith: value))]. + ^answer +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: collectBlock thenDo: actionBlock + self associationsDo: [:x | | fx | + fx := collectBlock evaluateWith: x value. + actionBlock evaluateWith: fx] +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +collect: collectBlock thenSelect: selectBlock + | answer | + answer := self species new. + self associationsDo: [:x | | fx | + fx := collectBlock evaluateWith: x value. + (selectBlock evaluateWith: fx) + ifTrue: [answer add: (answer associationClass key: x key value: fx)]]. + ^answer +! ! + +!Dictionary methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + | copy | + copy := self species new: tally. + table policy == self ifFalse: [copy usePolicy: table policy copy]. + self associationsDo: [:element | copy add: element copy]. + ^copy +! ! + +!Dictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultPolicy + ^super defaultPolicy associationClass: self associationClass +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + super do: [:assoc | aBlock evaluateWith: assoc value] +! ! + +!Dictionary methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +doesNotUnderstand: aMessage + ^self + at: aMessage selector asString asLowercase + ifAbsent: [super doesNotUnderstand: aMessage] +! ! + +!Dictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +equates: key with: association + ^key = association key +! ! + +!Dictionary methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +includesKey: key + ^(table lookupKey: key) !!== nil +! ! + +!Dictionary methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDictionary + ^true +! ! + +!Dictionary methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isOrderedDictionary + ^false +! ! + +!Dictionary methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyAtValue: anObject + ^self keyAtValue: anObject ifAbsent: nil +! ! + +!Dictionary methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyAtValue: anObject ifAbsent: aBlock + self associationsDo: [:assoc | assoc value = anObject ifTrue: [^assoc key]]. + ^aBlock value +! ! + +!Dictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyCollector + ^Set new: self size +! ! + +!Dictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyFor: anObject + ^anObject key +! ! + +!Dictionary methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyNotFound: anObject + KeyNotFound signalFor: anObject +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +keys + | keys | + keys := self keyCollector. + self keysDo: [:k | keys add: k]. + ^keys +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +keysAndElementsDo: aBlock + self associationsDo: [:assoc | aBlock evaluateWith: assoc key with: assoc] +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +keysAndValuesDo: aBlock + self associationsDo: [:assoc | aBlock value: assoc key value: assoc value] +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +keysDo: aBlock + self associationsDo: [:assoc | aBlock evaluateWith: assoc key] +! ! + +!Dictionary methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +occurrencesOf: anObject + | count | + count := 0. + self do: [:value | value = anObject ifTrue: [count := count + 1]]. + ^count +! ! + +!Dictionary methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +postCopy + super postCopy. + self storesAssociations ifTrue: [table copyAssociations] +! ! + +!Dictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +rebuildOn: aDictionary + self + keysAndElementsDo: [:key :assoc | aDictionary + basicAt: key + put: assoc + for: aDictionary]. + table := aDictionary table +! ! + +!Dictionary methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: anObject ifAbsent: aBlock + ^self shouldNotImplement +! ! + +!Dictionary methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAssociation: anAssociation + self removeKey: anAssociation key +! ! + +!Dictionary methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeKey: key + self removeKey: key ifAbsent: [self keyNotFound: key] +! ! + +!Dictionary methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeKey: key ifAbsent: aBlock + ^self basicRemoveKey: key ifAbsent: aBlock +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: aBlock + | selection | + selection := self species new. + self + associationsDo: [:assoc | (aBlock evaluateWith: assoc value) + ifTrue: [selection add: assoc]]. + ^selection +! ! + +!Dictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: selectBlock thenCollect: collectBlock + | answer | + answer := self species new. + self keysAndValuesDo: [:key :value | | assoc | + (selectBlock evaluateWith: value) ifTrue: [ + assoc := answer associationClass + key: key + value: (collectBlock evaluateWith: value). + answer add: assoc]]. + ^answer +! ! + +!Dictionary methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + | first | + self isEmpty + ifTrue: [^aStream nextPutAll: self class name; nextPutAll: ' new']. + first := true. + aStream + nextPut: $(; + nextPutAll: self class name; + nextPutAll: ' new'. + self associationsDo: [:assoc | + first ifFalse: [aStream nextPut: $;]. + aStream crtab; nextPutAll: 'add: '. + assoc storeOn: aStream. + first := false]. + aStream + nextPut: $;; + crtab; + nextPutAll: 'yourself'; + nextPut: $) +! ! + +!Dictionary methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storesAssociations + ^true +! ! + +!Dictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +values + | values | + values := Bag new. + self do: [:each | values add: each]. + ^values +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Dictionary class' category: #Kernel! +Dictionary class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/EndOfStream.Class.st b/modules/Kernel/EndOfStream.Class.st new file mode 100644 index 00000000..2a5bede7 --- /dev/null +++ b/modules/Kernel/EndOfStream.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #EndOfStream category: #Kernel! +Error subclass: #EndOfStream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!EndOfStream commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!EndOfStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultDescription + ^'end of stream' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'EndOfStream class' category: #Kernel! +EndOfStream class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/Ephemeron.Class.st b/modules/Kernel/Ephemeron.Class.st new file mode 100644 index 00000000..0a07abd7 --- /dev/null +++ b/modules/Kernel/Ephemeron.Class.st @@ -0,0 +1,108 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Ephemeron category: #Kernel! +Association subclass: #Ephemeron + instanceVariableNames: 'key value registry' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Ephemeron commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Ephemeron methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += anEphemeron + ^anEphemeron class == self class and: [key = anEphemeron key] +! ! + +!Ephemeron methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +activate + self _beSpecial +! ! + +!Ephemeron methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +deactivate + self _beNotSpecial +! ! + +!Ephemeron methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^key hash +! ! + +!Ephemeron methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + self activate +! ! + +!Ephemeron methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +key + ^key +! ! + +!Ephemeron methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +key: anObject + key := anObject +! ! + +!Ephemeron methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +key: anObject value: aDictionary + key := anObject. + value := aDictionary +! ! + +!Ephemeron methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream + print: key; + nextPutAll: ' → '; + print: value +! ! + +!Ephemeron methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +registry + ^registry +! ! + +!Ephemeron methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +registry: weakRegistry + registry := weakRegistry +! ! + +!Ephemeron methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +rescue + registry isNil ifFalse: [registry rescue: self] +! ! + +!Ephemeron methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +value + ^value +! ! + +!Ephemeron methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: aDictionary + value := aDictionary +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Ephemeron class' category: #Kernel! +Ephemeron class + instanceVariableNames: ''! + +!Ephemeron class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +key: anObject + ^self new key: anObject +! ! + +!Ephemeron class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +key: anObject value: aDictionary + ^self new key: anObject value: aDictionary +! ! + + +Ephemeron initialize! + diff --git a/modules/Kernel/Error.Class.st b/modules/Kernel/Error.Class.st new file mode 100644 index 00000000..af1af2bd --- /dev/null +++ b/modules/Kernel/Error.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Error category: #Kernel! +Exception subclass: #Error + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Error commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Error methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isResumable + ^false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Error class' category: #Kernel! +Error class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/EventHandlerMessage.Class.st b/modules/Kernel/EventHandlerMessage.Class.st new file mode 100644 index 00000000..fbb4bad3 --- /dev/null +++ b/modules/Kernel/EventHandlerMessage.Class.st @@ -0,0 +1,46 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #EventHandlerMessage category: #Kernel! +MessageSend subclass: #EventHandlerMessage + instanceVariableNames: 'arity' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!EventHandlerMessage commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!EventHandlerMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +arity + ^arity +! ! + +!EventHandlerMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject selector: aSymbol arguments: anArray + super receiver: anObject selector: aSymbol arguments: anArray. + arity := selector arity. + arguments size > arity ifTrue: [ + self + error: 'The event expects no more than ' , arity asString + , (' argument' pluralize: arity > 1)] +! ! + +!EventHandlerMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +selector: aSymbol + self ASSERT: false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'EventHandlerMessage class' category: #Kernel! +EventHandlerMessage class + instanceVariableNames: ''! + +!EventHandlerMessage class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject selector: aSymbol + ^self new receiver: anObject; selector: aSymbol +! ! + + diff --git a/modules/Kernel/Exception.Class.st b/modules/Kernel/Exception.Class.st new file mode 100644 index 00000000..d5b14ac0 --- /dev/null +++ b/modules/Kernel/Exception.Class.st @@ -0,0 +1,241 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #Exception category: #Kernel! +Object subclass: #Exception + instanceVariableNames: 'description activeHandler signalContext resumeBlock resignaledException' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Exception commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Exception methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +activeHandler + ^activeHandler +! ! + +!Exception methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +activeHandler: anExceptionHandler + activeHandler := anExceptionHandler +! ! + +!Exception methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +defaultAction + Kernel unhandledException: self +! ! + +!Exception methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +defaultDescription + ^self class name +! ! + +!Exception methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +defaultValue + ^nil +! ! + +!Exception methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +description + ^description ifNil: [self defaultDescription] +! ! + +!Exception methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +description: aString + description := aString +! ! + +!Exception methodsFor: 'process flow' stamp: 'KenD 28/Jun/2026 13:27:39'! +doDefaultAction + ^self defaultAction +! ! + +!Exception methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:39'! +doSignal + self isActive ifTrue: [^self ASSERT: false]. + signalContext := Processor activeProcess. + ^self outer +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +evaluateHandler: anExceptionHandler + | prev result | + prev := activeHandler. + activeHandler := anExceptionHandler. + [ + result := anExceptionHandler isNil + ifTrue: [self doDefaultAction] + ifFalse: [anExceptionHandler handle: self]] + ensure: [activeHandler := prev]. + ^result +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +evaluateHandlers + | handler | + handler := Processor activeProcess findHandlerFor: self. + ^self evaluateHandler: handler +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +exit + self exit: self defaultValue +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +exit: value + self isResumable ifTrue: [self resume: value] ifFalse: [self return: value] +! ! + +!Exception methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasNextHandler + ^self nextHandler notNil +! ! + +!Exception methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isActive + ^activeHandler notNil +! ! + +!Exception methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isHandled + | handler | + handler := Processor activeProcess findHandlerFor: self. + ^handler notNil +! ! + +!Exception methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isResumable + ^true +! ! + +!Exception methodsFor: 'process flow' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextHandler + ^activeHandler notNil ifTrue: [activeHandler nextHandlerFor: self] +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +outer + | prev result | + prev := resumeBlock. + [ + resumeBlock := [:res | ^res]. + result := self evaluateHandlers] + ensure: [resumeBlock := prev]. + ^result +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +pass + self resume: self evaluateHandlers +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +reset + activeHandler := signalContext := nil +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +resignal + self resignalAs: self shallowCopy reset +! ! + +!Exception methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:39'! +resignalAs: anException + resignaledException := anException. + self resume: nil +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +resume + self resume: self defaultValue +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +resume: value + self isResumable + ifFalse: [Error signal: 'cannot resume from a non-resumable exception']. + resumeBlock value: value +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +retry + activeHandler retry +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +retryUsing: aBlock + activeHandler retryUsing: aBlock +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +return + self return: self defaultValue +! ! + +!Exception methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +return: value + signalContext := nil. + activeHandler return: value +! ! + +!Exception methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:39'! +signal + | signaller result | + signaller := self. + [signaller notNil] whileTrue: [ + resignaledException := nil. + result := signaller doSignal. + signaller := resignaledException]. + ^result +! ! + +!Exception methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +stacktrace + ^signalContext backtrace. +! ! + +!Exception methodsFor: 'sunit' stamp: 'KenD 28/Jun/2026 13:27:39'! +sunitRetry + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Exception class' category: #Kernel! +Exception class + instanceVariableNames: ''! + +!Exception class methodsFor: 'composition' stamp: 'KenD 28/Jun/2026 13:27:39'! +, aClass + ^ExceptionSet with: self with: aClass +! ! + +!Exception class methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +includesException: anException + ^anException isKindOf: self +! ! + +!Exception class methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +isHandled + ^self basicNew isHandled +! ! + +!Exception class methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeHidden: aSymbol + ^#(#pass #signal) includes: aSymbol +! ! + +!Exception class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +signal + ^self new signal +! ! + +!Exception class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +signal: aString + ^self new description: aString; signal +! ! + + diff --git a/modules/Kernel/ExceptionHandler.Class.st b/modules/Kernel/ExceptionHandler.Class.st new file mode 100644 index 00000000..83e2df1f --- /dev/null +++ b/modules/Kernel/ExceptionHandler.Class.st @@ -0,0 +1,137 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ExceptionHandler category: #Kernel! +Object subclass: #ExceptionHandler + instanceVariableNames: 'filter previous handlerBlock protectedBlock return' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ExceptionHandler commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ExceptionHandler methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateFor: anException + ^handlerBlock argumentCount = 0 + ifTrue: [handlerBlock value] + ifFalse: [handlerBlock value: anException] +! ! + +!ExceptionHandler methodsFor: 'activation' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateProtectedBlock + return := [:result | ^result]. + ^protectedBlock value +! ! + +!ExceptionHandler methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +findHandlerFor: anException + | handler | + handler := self. + [handler notNil] whileTrue: [ + (handler handles: anException) ifTrue: [^handler]. + handler := handler nextHandler]. + ^nil +! ! + +!ExceptionHandler methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +handle: anException + | result | + Processor activeProcess + useExceptionHandler: previous + while: [result := self evaluateFor: anException]. + anException reset. + self return: result +! ! + +!ExceptionHandler methodsFor: 'activation' stamp: 'KenD 28/Jun/2026 13:27:38'! +handle: exceptionClass with: hBlock during: pBlock + | result active | + filter := exceptionClass. + handlerBlock := hBlock. + protectedBlock := pBlock. + active := Processor activeProcess. + previous := active exceptionHandler. + active + useExceptionHandler: self + while: [[ + result := self evaluateProtectedBlock. + self shouldRetry: result] whileTrue]. + ^result +! ! + +!ExceptionHandler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +handles: anException + ^filter includesException: anException +! ! + +!ExceptionHandler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextHandler + ^previous +! ! + +!ExceptionHandler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextHandlerFor: anException + ^previous notNil ifTrue: [previous findHandlerFor: anException] +! ! + +!ExceptionHandler methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream + nextPutAll: self class name withArticle; cr; + nextPutAll: ' for '; + nextPutAll: filter printString; cr; + nextPutAll: ' with handler '; cr; + nextPutAll: handlerBlock printString; cr; + nextPutAll: ' and protected block '; cr; + nextPutAll: protectedBlock printString; cr; + nextPutAll: ' returning '; + nextPutAll: return printString; cr; + nextPutAll: ' previous handler '; + nextPutAll: previous printString; cr +! ! + +!ExceptionHandler methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +retry + self return: self retryToken +! ! + +!ExceptionHandler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +retryToken + ^return +! ! + +!ExceptionHandler methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +retryUsing: aBlock + protectedBlock := aBlock. + self retry +! ! + +!ExceptionHandler methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +return: result + return value: result +! ! + +!ExceptionHandler methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +shouldRetry: anObject + ^anObject == self retryToken +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExceptionHandler class' category: #Kernel! +ExceptionHandler class + instanceVariableNames: ''! + +!ExceptionHandler class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +handle: exceptionClass with: handlerBlock during: userBlock + ^self new handle: exceptionClass with: handlerBlock during: userBlock +! ! + +!ExceptionHandler class methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +shouldBeHidden: aSymbol + ^true +! ! + + diff --git a/modules/Kernel/ExceptionSet.Class.st b/modules/Kernel/ExceptionSet.Class.st new file mode 100644 index 00000000..599a3999 --- /dev/null +++ b/modules/Kernel/ExceptionSet.Class.st @@ -0,0 +1,65 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ExceptionSet category: #Kernel! +Object subclass: #ExceptionSet + instanceVariableNames: 'exceptions' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ExceptionSet commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ExceptionSet methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +, aClass + (exceptions includes: aClass) ifTrue: [^self]. + ^self class with: aClass withAll: exceptions +! ! + +!ExceptionSet methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: aClass + ^exceptions add: aClass +! ! + +!ExceptionSet methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addAll: classesCollection + exceptions addAll: classesCollection +! ! + +!ExceptionSet methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +includesException: anException + ^exceptions anySatisfy: [:class | class includesException: anException] +! ! + +!ExceptionSet methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + exceptions := Set new +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExceptionSet class' category: #Kernel! +ExceptionSet class + instanceVariableNames: ''! + +!ExceptionSet class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aClass + ^self new add: aClass +! ! + +!ExceptionSet class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aClass with: bClass + ^self new add: aClass; add: bClass; yourself +! ! + +!ExceptionSet class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aClass withAll: classesCollection + ^self new add: aClass; addAll: classesCollection; yourself +! ! + + +ExceptionSet initialize! + diff --git a/modules/Kernel/False.Class.st b/modules/Kernel/False.Class.st new file mode 100644 index 00000000..e9370703 --- /dev/null +++ b/modules/Kernel/False.Class.st @@ -0,0 +1,131 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #False category: #Kernel! +Boolean subclass: #False + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!False commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +& aBoolean + ^self +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +| aBoolean + ^aBoolean +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +and: aBlock + ^false +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +and: block1 and: block2 + ^self +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +and: block1 and: block2 and: block3 + ^self +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +and: block1 andNot: block2 + ^self +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +andNot: aBlock + ^self +! ! + +!False methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asParameter + ^0 +! ! + +!False methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicHash + ^0 +! ! + +!False methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^0 +! ! + +!False methodsFor: 'flow control' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifFalse: aBlock + ^aBlock value +! ! + +!False methodsFor: 'flow control' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifFalse: aBlock ifTrue: anotherBlock + ^aBlock value +! ! + +!False methodsFor: 'flow control' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifTrue: aBlock + ^nil +! ! + +!False methodsFor: 'flow control' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifTrue: aBlock ifFalse: anotherBlock + ^anotherBlock value +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +not + ^true +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +or: aBlock + ^aBlock value +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +or: aBlock or: anotherBlock + ^aBlock value or: [anotherBlock value] +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +orNot: aBlock + ^aBlock value not +! ! + +!False methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: 'false' +! ! + +!False methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +xor: aBlock + ^aBlock value +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'False class' category: #Kernel! +False class + instanceVariableNames: ''! + +!False class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +allInstances + ^{false} +! ! + +!False class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBeDeleted + ^false +! ! + + diff --git a/modules/Kernel/Float.Class.st b/modules/Kernel/Float.Class.st new file mode 100644 index 00000000..b5e6a326 --- /dev/null +++ b/modules/Kernel/Float.Class.st @@ -0,0 +1,859 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Float category: #Kernel! +Number subclass: #Float + instanceVariableNames: '' + classVariableNames: 'E Infinity MinusInfinity Pi RadiansPerDegree Status' + poolDictionaries: '' + category: 'Kernel'! +!Float commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aNumber + ^self errorVMSpecific +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +* aNumber + ^self errorVMSpecific +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +/ aNumber + ^self errorVMSpecific +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +// aNumber + | quo q | + q := self / aNumber. + quo := q truncated. + q positive ifTrue: [^quo]. + ^quo = q ifTrue: [quo] ifFalse: [quo - 1] +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +~ aFloat + | delta distance | + aFloat isFloat ifFalse: [^self isCloseTo: aFloat]. + self isSpecialValue ifTrue: [^self = aFloat]. + aFloat isSpecialValue ifTrue: [^false]. + delta := aFloat - self. + (-0.1e-289 < delta and: [delta < 0.1e-289]) ifTrue: [^true]. + self = 0.0 ifTrue: [^false]. + delta = aFloat ifTrue: [^false]. + distance := delta / self. + ^-1.0e-10 < distance and: [distance < 1.0e-10] +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aNumber + ^self errorVMSpecific +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aNumber + ^self errorVMSpecific +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<~ aNumber + | float | + float := aNumber asFloat. + ^(float < self) not or: [self ~ float] +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aNumber + ^self < aNumber or: [self = aNumber] +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aNumber + ^self errorVMSpecific +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aNumber + ^aNumber asFloat < self +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>~ aNumber + | float | + float := aNumber asFloat. + ^(self < float) not or: [self ~ float] +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aNumber + ^(self < aNumber asFloat) not +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +abs + self isNaN ifTrue: [^self]. + ^self < 0.0 ifTrue: [^0.0 - self] ifFalse: [self] +! ! + +!Float methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +arcTan + ^Kernel host libc atan: self +! ! + +!Float methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asByteArray + | array | + array := ByteArray new: self size. + array + replaceBytesFrom: 1 + to: self size + with: self + startingAt: 1. + ^array +! ! + +!Float methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asFloat + ^self +! ! + +!Float methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asFraction + ^self asTrueFraction +! ! + +!Float methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asNormalized + ^self isDenormalizedValue ifTrue: [0.0] ifFalse: [self] +! ! + +!Float methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asTrueFraction + | high exponent positive low significand fraction exp zeroes numerator denominator | + self isSpecialValue + ifTrue: [self + error: 'cannot represent ' , self printString , ' as a fraction']. + high := self uLongAtOffset: 4. + exponent := high bitShift: -20. + positive := (exponent bitAnd: 16r800) = 0. + positive ifFalse: [exponent := exponent bitAnd: 16r7FF]. + low := self uLongAtOffset: 0. + significand := ((high bitAnd: 16rFFFFF) bitShift: 32) + low. + (exponent = 0 and: [significand = 0]) ifTrue: [^0]. + fraction := exponent = 0 + ifTrue: [significand bitShift: 1] + ifFalse: [significand bitOr: 16r10000000000000]. + positive ifFalse: [fraction := fraction negated]. + exp := 1075 - exponent. + exp < 0 ifTrue: [^fraction bitShift: exp negated]. + zeroes := fraction lowBit - 1. + exp := exp - zeroes. + exp <= 0 ifTrue: [^fraction bitShift: zeroes negated - exp]. + numerator := fraction bitShift: zeroes negated. + exp = 0 ifTrue: [^numerator]. + denominator := 1 bitShift: exp. + ^numerator / denominator +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + ^self errorVMSpecific +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: index + ^self errorVMSpecific +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +ceiling + ^self isNaN ifTrue: [self] ifFalse: [super ceiling] +! ! + +!Float methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +coerce: aNumber + ^aNumber asFloat +! ! + +!Float methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +cos + ^Kernel host libc cos: self +! ! + +!Float methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +degreesToRadians + ^self * RadiansPerDegree +! ! + +!Float methodsFor: 'random' stamp: 'KenD 28/Jun/2026 13:27:38'! +errorOn: aSymbol + ^self errorVMSpecific +! ! + +!Float methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +errorOn: aSymbol status: anInteger + ^self class errorOn: aSymbol status: anInteger for: self +! ! + +!Float methodsFor: 'logarithms' stamp: 'KenD 28/Jun/2026 13:27:38'! +exp + ^Kernel host libc exp: self +! ! + +!Float methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +exponent + | bits | + bits := (self at: 8) * 256 + (self at: 7). + bits := bits // 16 bitAnd: 2r11111111111. + ^bits > 0 + ifTrue: [bits < 2047 ifTrue: [bits - 1023] ifFalse: [self]] + ifFalse: [self asNormalized exponent] +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +floor + ^self isNaN ifTrue: [self] ifFalse: [super floor] +! ! + +!Float methodsFor: 'random' stamp: 'KenD 28/Jun/2026 13:27:38'! +fractionPart + ^self errorVMSpecific +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasFixedSize + ^true +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + | hash | + self isSpecialValue ifFalse: [ + self fractionPart = 0.0 ifTrue: [ + ((self + between: -1073741824.0 "SmallInteger smallestNegative" + and: 1073741823.0 "SmallInteger largestPositive") + or: [9007199254740992.0 < self] + or: [self < -9007199254740992.0 "53 bits of mantissa"]) + ifTrue: [^self truncated hash]]]. + hash := 8. + 1 + to: 8 + do: [:i | hash := (hash hashMultiply: 16r19660D) bitXor: (self at: i)]. + ^hash +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasZeroExponent + ^((self at: 8) bitAnd: 16r7F) = 0 and: [((self at: 7) bitAnd: 16rF0) = 0] +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasZeroMantissa + ((self at: 7) bitAnd: 16rF) = 0 ifFalse: [^false]. + (self at: 6) = 0 ifFalse: [^false]. + (self at: 5) = 0 ifFalse: [^false]. + (self at: 4) = 0 ifFalse: [^false]. + (self at: 3) = 0 ifFalse: [^false]. + (self at: 2) = 0 ifFalse: [^false]. + ^(self at: 1) = 0 +! ! + +!Float methodsFor: 'random' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeWith: bytes + self errorVMSpecific +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDenormalizedValue + ^self hasZeroExponent and: [self hasZeroMantissa not] +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFloat + ^true +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isInfinite + ^self = Infinity or: [self = MinusInfinity] +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isInfinity + ^self = Infinity +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMinusInfinity + ^self = MinusInfinity +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isNaN + ^self isSpecialValue and: [self hasZeroMantissa not] +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSpecialValue + ^((self uShortAtOffset: 6) bitAnd: 16r7FF0) = 16r7FF0 +! ! + +!Float methodsFor: 'logarithms' stamp: 'KenD 28/Jun/2026 13:27:38'! +ln + self > 0 + ifFalse: [^self error: 'ln is not defined for ' , self printString]. + ^Kernel host libc log: self +! ! + +!Float methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +mantissa + ^self significand +! ! + +!Float methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +marshalOn: aStream + aStream putBytesFrom: self from: 1 to: 8 +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +negated + ^-1.0 * self +! ! + +!Float methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printDecimals: decimals separatedBy: aString + | fraction digits | + self isNaN ifTrue: [^'NAN']. + (self = 0.0 or: [self exponent + decimals < self class maxExponent]) + ifFalse: [^self asString]. + digits := 10 raisedToInteger: decimals. + fraction := (self * digits) rounded / digits. + ^fraction printDecimals: decimals separatedBy: aString +! ! + +!Float methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + self printOn: aStream separatedBy: ActiveLocale decimalSeparator +! ! + +!Float methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream separatedBy: separator + | number factor scientificThreshold maxDigits digits integer reverse exp | + self isNaN ifTrue: [^aStream nextPutAll: 'NAN']. + self = Infinity ifTrue: [^aStream nextPutAll: '+infinite']. + self = MinusInfinity ifTrue: [^aStream nextPutAll: '-infinite']. + self < 0.0 ifTrue: [ + aStream nextPut: $-. + ^self negated printOn: aStream separatedBy: separator]. + (self = 0.0 or: [self isDenormalizedValue]) ifTrue: [ + ^aStream + nextPut: $0; + nextPutAll: separator; + nextPut: $0]. + number := self. + factor := 0.5e-14. + scientificThreshold := 13. + digits := (number log: 10) truncated. + number := number / (digits asFloat * 10.0 ln) exp + factor. + number >= 10.0 ifTrue: [ + number := number / 10.0. + digits := digits + 1]. + digits = 0 ifFalse: [ + ((digits between: scientificThreshold negated and: scientificThreshold) + and: [ + digits >= 0 or: [| n | + n := number * ((digits + scientificThreshold) asFloat * 10.0 ln) exp. + (n fractionPart * (digits negated * 10.0 ln) exp) truncated = 0]]) + ifTrue: [ + number := number * (digits asFloat * 10.0 ln) exp. + factor := factor * (digits * 10.0 ln) exp. + digits := 0]]. + exp := digits. + integer := number truncated. + number := number fractionPart. + reverse := String streamContents: [:strm | + [integer >= 10] whileTrue: [ + strm nextPut: (Character digitValue: integer \\ 10). + integer := integer // 10]. + strm nextPut: (Character digitValue: integer)]. + aStream nextPutAll: reverse reversed. + maxDigits := 15. + digits := maxDigits - reverse size - 1. + aStream nextPutAll: separator. + factor := factor * 2.0. + [ + number := number * 10.0. + integer := number truncated. + number := number fractionPart. + aStream nextPut: (Character digitValue: integer). + digits := digits - 1. + digits positive and: [ + factor := factor * 10.0. + factor <= number]] whileTrue. + exp = 0 ifFalse: [ + aStream nextPut: $e. + exp printOn: aStream] +! ! + +!Float methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +radiansToDegrees + ^self / RadiansPerDegree +! ! + +!Float methodsFor: 'logarithms' stamp: 'KenD 28/Jun/2026 13:27:38'! +raisedTo: aNumber + | n base | + aNumber \\ 1.0 = 0.0 ifTrue: [^self raisedToInteger: aNumber asInteger]. + (self = 0.0 and: [aNumber > 0.0]) ifTrue: [^0.0]. + self positive ifTrue: [ + base := aNumber * self abs ln. + ^base >= self class maxForExp + ifTrue: [self class infinity] + ifFalse: [base exp]]. + n := aNumber rounded. + aNumber = n ifTrue: [^self raisedToInteger: n]. + ^(ArithmeticError on: #raisedTo:) signalInvalidOperation +! ! + +!Float methodsFor: 'logarithms' stamp: 'KenD 28/Jun/2026 13:27:38'! +raisedToInteger: anInteger + ^(super raisedToInteger: anInteger) asFloat +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +reciprocal + ^1.0 / self +! ! + +!Float methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop with: anObject startingAt: position + self + replaceBytesFrom: start + to: stop + with: anObject + startingAt: position +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +rounded + self isNaN ifTrue: [^self]. + self isInfinite ifTrue: [^self]. + ^self fractionPart abs < 0.5 + ifTrue: [self truncated] + ifFalse: [self truncated + self sign rounded] +! ! + +!Float methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sign + self isNaN ifTrue: [^self]. + ^super sign +! ! + +!Float methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +significand + ^self errorVMSpecific +! ! + +!Float methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +sin + ^Kernel host libc sin: self +! ! + +!Float methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^8 +! ! + +!Float methodsFor: 'functions' stamp: 'KenD 28/Jun/2026 13:27:38'! +sqrt + ^self errorVMSpecific +! ! + +!Float methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + self printOn: aStream separatedBy: '.' +! ! + +!Float methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +tan + ^Kernel host libc tan: self +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +timesTwoPower: anInteger + ^self errorVMSpecific +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncated + ^self errorVMSpecific +! ! + +!Float methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLongAtOffset: offset + | low high | + low := self uShortAtOffset: offset. + high := self uShortAtOffset: offset + 2. + high := high bitShift: 16. + ^high + low +! ! + +!Float methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +uShortAtOffset: offset + ^(self at: offset + 1) + ((self at: offset + 2) bitShift: 8) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Float class' category: #Kernel! +Float class + instanceVariableNames: 'E Infinity MinusInfinity Pi RadiansPerDegree Status'! + +!Float class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicErrorOn: aSymbol status: status for: aNumber + self error: 'Float error ' , aSymbol. + #FloatPlus. #FloatMinus. #FloatMultiply. #FloatDiv. #FloatLess. #FloatEqual. + #FloatFractionPart. #FloatSignificand. #FloatSqrt. #FloatTimesTwoPower. #FloatTruncated "hack to get the symbols interned in kernel" +! ! + +!Float class methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +clearStatusFlags + Status at: 1 put: ((Status at: 1) bitAnd: 0xC0). + self _status: Status +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +e + " + Float e + " + ^E +! ! + +!Float class methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +errorOn: aSymbol status: status for: aNumber + | error | + (self hasZeroDivisorFlag: status) + ifTrue: [^ZeroDivide new dividend: aNumber; operation: aSymbol; signal]. + error := ArithmeticError on: aSymbol. + (self hasOverflowFlag: status) ifTrue: [^error signalOverflow]. + (self hasUnderflowFlag: status) ifTrue: [^error signalUnderflow]. + (self hasDenormalizedOperandFlag: status) ifTrue: [^error signalDenormalized]. + (self hasInvalidOperationFlag: status) + ifTrue: [^error signalInvalidOperation]. + (self hasCoprocessorMissingFlag: status) + ifTrue: [^error signalCoprocessorMissing]. + (self hasInexactFlag: status) ifTrue: [^error signalInexactOperation]. + ^error signalUndefined +! ! + +!Float class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +from: aNumber + ^aNumber asFloat +! ! + +!Float class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromByteArray: aByteArray + ^self new initializeWith: aByteArray +! ! + +!Float class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromBytes: anObject + | float | + ^anObject isByteArray ifTrue: [self fromByteArray: anObject] ifFalse: [ + float := self new. + float replaceBytesFrom: 1 to: 8 with: anObject startingAt: 1. + ^float] +! ! + +!Float class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromInteger: anInteger + ^self errorVMSpecific +! ! + +!Float class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromLocalString: aString + | thous dec string currency sign float | + aString isEmpty ifTrue: [^0.0]. + thous := ActiveLocale thousandsSeparator. + dec := ActiveLocale decimalSeparator. + string := thous = dec + ifTrue: [aString] + ifFalse: [aString reject: [:c | thous includes: c]]. + currency := ActiveLocale currency first. + string := string reject: [:c | c = currency]. + string isEmpty ifTrue: [^0.0]. + sign := 1.0. + (string first = $( and: [string last = $)]) ifTrue: [ + string := string copyFrom: 2 to: string size - 1. + sign := -1.0]. + float := self fromString: string decimalSeparator: dec. + ^float * sign +! ! + +!Float class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString decimalSeparator: anotherString + ^(super fromString: aString decimalSeparator: anotherString) asFloat +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasCoprocessorMissingFlag + ^self hasCoprocessorMissingFlag: self status +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasCoprocessorMissingFlag: status + ^(status bitAnd: 128) ~= 0 +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasDenormalizedOperandFlag + ^self hasDenormalizedOperandFlag: self status +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasDenormalizedOperandFlag: status + ^(status bitAnd: 2) !!= 0 +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasErrorFlag: status + ^(status bitAnd: 0x1F) !!= 0 +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasFixedSize + ^self hasVariableSize not +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasInexactFlag + ^self hasInexactFlag: self status +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasInexactFlag: status + ^(status bitAnd: 32) ~= 0 +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasInvalidOperationFlag + ^self hasInvalidOperationFlag: self status +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasInvalidOperationFlag: status + ^(status bitAnd: 1) ~= 0 +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasOverflowFlag + ^self hasOverflowFlag: self status +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasOverflowFlag: status + ^(status bitAnd: 8) ~= 0 +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasUnderflowFlag + ^self hasUnderflowFlag: self status +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasUnderflowFlag: status + ^(status bitAnd: 16) ~= 0 +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasVariableSize + ^false +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasZeroDivisorFlag + ^self hasZeroDivisorFlag: self status +! ! + +!Float class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasZeroDivisorFlag: status + ^(status bitAnd: 4) ~= 0 +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +infinity + " + Float infinity + " + ^Infinity +! ! + +!Float class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeConstants + " + Float initializeConstants + " + self + initializeInfinity; + initializeMinusInfinity; + initializePi; + initializeE +! ! + +!Float class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeE + E := self fromByteArray: #[105 87 20 139 10 191 5 64] +! ! + +!Float class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeInfinity + Infinity := self fromByteArray: #[00 00 00 00 00 00 0xF0 0x7F] +! ! + +!Float class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeMinusInfinity + MinusInfinity := self fromByteArray: #[00 00 00 00 00 00 0xF0 0xFF] +! ! + +!Float class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializePi + Pi := 3.14159265358979323846264338327950288 +! ! + +!Float class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeRadiansPerDegree + RadiansPerDegree := Pi / 180.0 +! ! + +!Float class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeStatus + Status isNil ifTrue: [Status := ByteArray new: 4]. + self _readStatusOn: Status +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxExponent + ^309 +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxForExp + self disableCode: [^(10.0 raisedTo: Float maxExponent - 1) ln]. + ^self fromByteArray: #[16r5E 16r2A 16rD6 16rD5 16r91 16r29 16r86 16r40] +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxNegativeValue + " + Float maxNegativeValue + " + ^self fromByteArray: #[0 0 0 0 0 0 16 128] +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxValue + " + Float maxValue + " + ^self fromByteArray: #[16rFF 16rFF 16rFF 16rFF 16rFF 16rFF 16rEF 16r7F] +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +minPositiveValue + " + Float minPositiveValue / 2 + " + ^self fromByteArray: #[0 0 0 0 0 0 16 0] +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +minusInfinity + " + Float minusInfinity + " + ^MinusInfinity +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +minValue + " + Float minValue + " + ^self fromByteArray: #[16rFF 16rFF 16rFF 16rFF 16rFF 16rFF 16rEF 16rFF] +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +multiplicativeIdentity + ^1.0 +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +nan + " + Float nan + " + ^self new + at: 7 put: 248; + at: 8 put: 127; + yourself +! ! + +!Float class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self errorVMSpecific +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +pi + " + Number pi + " + ^Pi +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +plusInfinity + " + Float plusInfinity + " + ^Infinity +! ! + +!Float class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^8 +! ! + +!Float class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +startUp + self initializeRadiansPerDegree +! ! + +!Float class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +status + ^Status uLongAtOffset: 0 +! ! + +!Float class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +statusVar + ^Status +! ! + +!Float class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +usingBytes: aByteArray + ^self new initializeWith: aByteArray +! ! + +!Float class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +zero + ^0.0 +! ! + + diff --git a/modules/Kernel/FloatUnderflow.Class.st b/modules/Kernel/FloatUnderflow.Class.st new file mode 100644 index 00000000..1a256bf6 --- /dev/null +++ b/modules/Kernel/FloatUnderflow.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #FloatUnderflow category: #Kernel! +Notification subclass: #FloatUnderflow + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!FloatUnderflow commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!FloatUnderflow methodsFor: 'error handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultAction + ^0.0 +! ! + +!FloatUnderflow methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +type + ^#underflow +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FloatUnderflow class' category: #Kernel! +FloatUnderflow class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/Fraction.Class.st b/modules/Kernel/Fraction.Class.st new file mode 100644 index 00000000..fcf38672 --- /dev/null +++ b/modules/Kernel/Fraction.Class.st @@ -0,0 +1,306 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Fraction category: #Kernel! +Number subclass: #Fraction + instanceVariableNames: 'numerator denominator' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Fraction commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aNumber + ^self + aNumber negated +! ! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +* aNumber + | d1 d2 | + aNumber isInteger ifTrue: [ + d2 := aNumber gcd: denominator. + d2 = denominator ifTrue: [^numerator * (aNumber // d2)]. + ^self class + numerator: numerator * (aNumber // d2) + denominator: denominator // d2]. + aNumber isFraction ifTrue: [ + d1 := numerator gcd: aNumber denominator. + d2 := denominator gcd: aNumber numerator. + (d2 = denominator and: [d1 = aNumber denominator]) + ifTrue: [^numerator // d1 * (aNumber numerator // d2)]. + ^self class + numerator: numerator // d1 * (aNumber numerator // d2) + denominator: denominator // d2 * (aNumber denominator // d1)]. + ^(aNumber coerce: self) * aNumber +! ! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +/ aNumber + ^self * aNumber reciprocal +! ! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +// aNumber + aNumber isInteger ifTrue: [^numerator // (denominator * aNumber)]. + aNumber isFraction + ifTrue: [^numerator * aNumber denominator + // (denominator * aNumber numerator)]. + ^(aNumber coerce: self) // aNumber +! ! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aNumber + | n d d1 d2 | + aNumber isInteger ifTrue: [ + ^self class + numerator: numerator + (denominator * aNumber) + denominator: denominator]. + aNumber isFraction ifTrue: [ + d := denominator gcd: aNumber denominator. + d1 := aNumber denominator // d. + d2 := denominator // d. + n := numerator * d1 + (aNumber numerator * d2). + d1 := d1 * d2. + d2 := n gcd: d. + n := n // d2. + d := d1 * (d // d2). + d = 1 ifTrue: [^n]. + ^Fraction numerator: n denominator: d]. + ^(aNumber coerce: self) + aNumber +! ! + +!Fraction methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aNumber + aNumber isInteger ifTrue: [^numerator < (denominator * aNumber)]. + aNumber isFraction + ifTrue: [^numerator * aNumber denominator + < (denominator * aNumber numerator)]. + ^(aNumber coerce: self) < aNumber +! ! + +!Fraction methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aNumber + aNumber isInteger ifTrue: [^numerator <= (denominator * aNumber)]. + aNumber isFraction + ifTrue: [^numerator * aNumber denominator + <= (denominator * aNumber numerator)]. + ^(aNumber coerce: self) <= aNumber +! ! + +!Fraction methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aNumber + aNumber isNumber ifFalse: [^false]. + aNumber isInteger ifTrue: [^numerator = (denominator * aNumber)]. + aNumber isFraction + ifTrue: [^numerator * aNumber denominator + = (denominator * aNumber numerator)]. + ^(aNumber coerce: self) = aNumber +! ! + +!Fraction methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aNumber + aNumber isInteger ifTrue: [^numerator > (denominator * aNumber)]. + aNumber isFraction + ifTrue: [^numerator * aNumber denominator + > (denominator * aNumber numerator)]. + ^(aNumber coerce: self) > aNumber +! ! + +!Fraction methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aNumber + aNumber isInteger ifTrue: [^numerator >= (denominator * aNumber)]. + aNumber isFraction + ifTrue: [^numerator * aNumber denominator + >= (denominator * aNumber numerator)]. + ^(aNumber coerce: self) >= aNumber +! ! + +!Fraction methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asFloat + " + Answer a Float that closely approximates the value of the receiver. + This implementation will answer the closest floating point number to the receiver. + It uses the IEEE 754 round to nearest even mode + (can happen in case denominator is a power of two) + Taken from Squeak. + Modified to throw Underflow instead of answering denormalized floats or 0.0 + " + | a b q r exponent floatExponent n ha hb hq q1 | + a := numerator abs. + b := denominator abs. + ha := a highBit. + hb := b highBit. + ("If both numerator and denominator are represented exactly in floating point number, + then fastest thing to do is to use hardwired float division" + ha < 54 and: [hb < 54]) ifTrue: [^numerator asFloat / denominator asFloat]. + "Try and obtain a mantissa with 54 bits. + First guess is rough, we might get one more bit or one less" + exponent := ha - hb - 54. + exponent > 0 + ifTrue: [b := b bitShift: exponent] + ifFalse: [a := a bitShift: exponent negated]. + q := a quo: b. + r := a - (q * b). + hq := q highBit. + "Squeak does gradual underflow. VSE does not use denormalized floats. " + floatExponent := exponent + hq - 1. + floatExponent > -1023 + ifFalse: [^(ArithmeticError on: #asFloat) signalUnderflow]. + n := 54. + hq > n ifTrue: [ + exponent := exponent + hq - n. + r := (q bitAnd: (1 bitShift: n - hq) - 1) * b + r. + q := q bitShift: n - hq]. + hq < n ifTrue: [ + exponent := exponent + hq - n. + q1 := (r bitShift: n - hq) quo: b. + q := (q bitShift: n - hq) bitAnd: q1. + r := r - (q1 * b)]. + (("check if we should round upward. + The case of exact half (q bitAnd: 1) isZero not & (r isZero) + will be handled by Integer>>asFloat" + q bitAnd: 1) = 0 or: [r = 0]) ifFalse: [q := q + 1]. + ^(self positive ifTrue: [q asFloat] ifFalse: [q asFloat negated]) + timesTwoPower: exponent +! ! + +!Fraction methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asFraction + ^self +! ! + +!Fraction methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asScaledDecimal + | pow2 pow5 q q5 | + pow2 := denominator lowBit - 1. + q := denominator bitShift: pow2 negated. + pow5 := 0. + [q = 1] whileFalse: [ + q5 := q // 5. + q - (5 * q5) = 0 ifFalse: [^super asScaledDecimal]. + q := q5. + pow5 := pow5 + 1]. + ^self withPrecision: (pow2 max: pow5) +! ! + +!Fraction methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +coerce: aNumber + ^aNumber asFraction +! ! + +!Fraction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +denominator + ^denominator +! ! + +!Fraction methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^numerator hashWith: denominator +! ! + +!Fraction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFraction + ^true +! ! + +!Fraction methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +negate + numerator := numerator negated +! ! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +negated + ^self class numerator: numerator negated denominator: denominator +! ! + +!Fraction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +numerator + ^numerator +! ! + +!Fraction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +numerator: n denominator: d + d = 0 ifTrue: [^self zeroDivisorOn: #numerator:denominator:]. + d negative + ifTrue: [ + numerator := n negated. + denominator := d negated] + ifFalse: [ + numerator := n. + denominator := d] +! ! + +!Fraction methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + numerator printOn: aStream. + aStream nextPut: $/. + denominator printOn: aStream +! ! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +raisedToInteger: anInteger + | num den | + anInteger = 0 ifTrue: [ + ^self isZero + ifTrue: [(ArithmeticError on: #raisedToInteger:) signalInvalidOperation] + ifFalse: [1]]. + anInteger < 0 ifTrue: [^self reciprocal raisedToInteger: anInteger negated]. + num := numerator raisedToInteger: anInteger. + den := denominator raisedToInteger: anInteger. + ^self class numerator: num denominator: den +! ! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +reciprocal + ^numerator abs = 1 + ifTrue: [denominator * numerator] + ifFalse: [self class numerator: denominator denominator: numerator] +! ! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +sqrt + | d n | + n := numerator sqrt. + d := denominator sqrt. + (n isInfinite or: [d isInfinite]) ifTrue: [^self asFloat sqrt]. + ^n / d +! ! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +squared + ^self class numerator: numerator squared denominator: denominator squared +! ! + +!Fraction methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncated + ^numerator quo: denominator +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Fraction class' category: #Kernel! +Fraction class + instanceVariableNames: ''! + +!Fraction class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString + | parts num den gcd | + parts := $/ split: aString. + parts isEmpty ifTrue: [^0]. + num := Number fromString: parts first trimBlanks. + num = 0 ifTrue: [^0]. + parts size = 1 ifTrue: [^num]. + den := Integer fromString: parts second trimBlanks. + gcd := num gcd: den. + ^self numerator: num // gcd denominator: den // gcd +! ! + +!Fraction class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +numerator: anInteger denominator: anotherInteger + ^self basicNew numerator: anInteger denominator: anotherInteger +! ! + + diff --git a/modules/Kernel/Halt.Class.st b/modules/Kernel/Halt.Class.st new file mode 100644 index 00000000..363a80c1 --- /dev/null +++ b/modules/Kernel/Halt.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Halt category: #Kernel! +Exception subclass: #Halt + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Halt commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Halt methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultDescription + ^'halt' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Halt class' category: #Kernel! +Halt class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/HashTable.Class.st b/modules/Kernel/HashTable.Class.st new file mode 100644 index 00000000..d8afb470 --- /dev/null +++ b/modules/Kernel/HashTable.Class.st @@ -0,0 +1,430 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #HashTable category: #Kernel! +Array subclass: #HashTable + instanceVariableNames: 'policy' + classVariableNames: 'NilToken Sizes' + poolDictionaries: '' + category: 'Kernel'! +!HashTable commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationClass + ^policy notNil ifTrue: [policy associationClass] ifFalse: [Association] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index put: anObject + | element | + element := anObject ifNil: [NilToken]. + ^self basicAt: index put: element +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +atKey: key hash: hash put: element + | index | + index := self indexOfKey: key hash: hash. + ^self at: index key: key put: element +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atKey: key put: element + | hash | + hash := self hashFor: key. + ^self atKey: key hash: hash put: element +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atKey: key sum: magnitude + | hash | + hash := self hashFor: key. + ^self atKey: key hash: hash sum: magnitude +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +beWeak + | empty | + empty := self emptySlot. + self withIndexDo: [:v :i | v isNil ifTrue: [self basicAt: i put: empty]]. + super beWeak +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +bucketClass + ^OpenHashTable +! ! + +!HashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +clearSlot: anInteger + self clearSlot: anInteger with: self emptySlot +! ! + +!HashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +clearSlot: anInteger with: emptySlot + self basicAt: anInteger put: emptySlot +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +clearSlots: indexes ifAbsent: absentBlock + | empty | + empty := self emptySlot. + indexes do: [:i | | v | + v := self at: i. + (v == nil or: [v == empty]) + ifTrue: [absentBlock value] + ifFalse: [self clearSlot: i with: empty]] +! ! + +!HashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +elementsDo: aBlock + self elementsDo: aBlock count: self size +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +emptySlot + ^policy notNil ifTrue: [policy emptySlot] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +equates: anObject1 with: anObject2 + ^policy notNil + ifTrue: [policy equates: anObject1 with: anObject2] + ifFalse: [anObject1 = anObject2] +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +findFirst: aBlock startingAt: index + | n i first slots | + n := self size. + first := i := index. + slots := self slotsPerElement. + [aBlock evaluateWith: (self at: i)] whileFalse: [ + i := i + slots. + i > n ifTrue: [i := 1]. + i = first ifTrue: [self error: 'element not found']]. + ^i +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashFor: anObject + ^policy notNil ifTrue: [policy hashFor: anObject] ifFalse: [anObject hash] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: key + | hash | + hash := self hashFor: key. + ^self indexOfHash: hash +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfHash: integer + ^integer \\ (self size // 2) + 1 +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfKey: key + | hash | + hash := self hashFor: key. + ^self indexOfKey: key hash: hash +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfKey: key hash: hash + | first empty | + first := self indexOfHash: hash. + empty := self emptySlot. + ^self + findFirst: [:obj | + obj == nil or: [obj == empty] or: [| k | + k := obj == NilToken ifFalse: [obj]. + self equates: key with: k]] + startingAt: first +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyFor: anObject + ^policy notNil ifTrue: [policy keyFor: anObject] ifFalse: [anObject] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyNotFound: anObject + KeyNotFound signalFor: anObject +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookupKey: key + ^self lookupKey: key ifAbsent: nil +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookupKey: key ifAbsent: aBlock + | index hash first empty | + hash := self hashFor: key. + first := self indexOfHash: hash. + empty := self emptySlot. + index := self + findFirst: [:obj | + obj == empty or: [| k | + k := obj == NilToken ifFalse: [obj]. + self equates: key with: k]] + startingAt: first. + ^self valueAt: index ifAbsent: aBlock +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookupValue: key ifAbsent: aBlock + ^self lookupKey: key ifAbsent: aBlock +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookUpValue: key ifAbsent: aBlock ifPresent: pBlock + | v | + v := self lookupValue: key ifAbsent: [^aBlock value]. + ^pBlock arity = 1 ifTrue: [pBlock evaluateWith: v] ifFalse: [pBlock value] +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookupValue: key ifPresent: aBlock + ^self lookUpValue: key ifAbsent: nil ifPresent: aBlock +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +owner + ^policy +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +owner: aHashedCollection + policy := aHashedCollection +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +policy + ^policy +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +policy: aHashTablePolicy + policy := aHashTablePolicy +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +rehash: indexes + | n index empty | + n := self size. + index := 1. + empty := self emptySlot. + indexes sort do: [:j | | v | + index := j max: index. + [ + index := index = n ifTrue: [1] ifFalse: [index + 1]. + v := self at: index. + v == nil or: [v == empty]] + whileFalse: [| k i | + k := self keyFor: v. + i := self indexOfKey: k. + v := self basicAt: i. + (v == nil or: [v == empty]) ifTrue: [self moveSlot: index to: i]]] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +rehashFrom: index1 to: index2 + | max empty n | + max := index2. + empty := self emptySlot. + n := self size. + self + withIndexDo: [:obj :i | | j v k | + i = n ifTrue: [max := 0]. + (obj == empty and: [i > max]) ifTrue: [^self]. + k := self keyFor: obj. + j := self indexOfKey: k. + v := self basicAt: j. + (v == nil or: [v == empty]) ifTrue: [self moveSlot: i to: j]] + startingAt: index1 +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAll + 1 to: self size do: [:i | self basicAt: i put: nil] +! ! + +!HashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeKey: key ifAbsent: aBlock + | index empty object | + index := self indexOfKey: key. + empty := self emptySlot. + object := self basicAt: index. + object == nil ifTrue: [^aBlock value]. + object == empty ifTrue: [^aBlock value]. + self clearSlot: index. + index := index + self slotsPerElement. + index > self size ifTrue: [index := 1]. + self + withIndexDo: [:obj :i | | j v k | + obj == empty ifTrue: [^self]. + k := self keyFor: obj. + j := self indexOfKey: k. + v := self basicAt: j. + (v == nil or: [v == empty]) ifTrue: [self moveSlot: i to: j]] + startingAt: index +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeKeys: keys ifAbsent: absentBlock + | indexes min max | + keys isEmpty ifTrue: [^self]. + min := self size + 1. + max := 0. + indexes := keys + collect: [:k | | index | + index := self indexOfKey: k. + index < min ifTrue: [min := index]. + max < index ifTrue: [max := index]. + index] + in: OrderedCollection new. + self clearSlots: indexes ifAbsent: absentBlock. + indexes size <= 1000 + ifTrue: [self rehash: indexes] + ifFalse: [self rehashFrom: min to: max] +! ! + +!HashTable methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceBackwardFrom: stop to: start with: aCollection startingAt: position + | i j | + i := stop. + j := position. + [start <= i] whileTrue: [ + self basicAt: i put: (aCollection at: j). + i := i - 1. + j := j - 1] +! ! + +!HashTable methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceForwardFrom: start to: stop with: aCollection startingAt: position + | i j | + i := start. + j := position. + [i <= stop] whileTrue: [ + self basicAt: i put: (aCollection at: j). + i := i + 1. + j := j + 1] +! ! + +!HashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +slotsPerElement + ^1 +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueAt: index ifAbsent: aBlock + | value | + value := self at: index. + value == nil ifTrue: [^aBlock value]. + value == self emptySlot ifTrue: [^aBlock value]. + ^value == NilToken ifFalse: [value] +! ! + +!HashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +withIndexDo: aBlock startingAt: anInteger + | n i first slots | + n := self size. + first := i := anInteger. + slots := self slotsPerElement. + [ + aBlock evaluateWith: (self at: i) with: i. + i := i + slots. + i > n ifTrue: [i := 1]. + i = first] whileFalse +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HashTable class' category: #Kernel! +HashTable class + instanceVariableNames: 'NilToken Sizes'! + +!HashTable class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeConstants + NilToken := Object new +! ! + +!HashTable class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeSizes + | primes p | + Sizes := ByteArray new: 126. + primes := #( + 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 + 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 + 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 + ) readStream. + p := primes next. + 1 to: Sizes size do: [:i | | n | + n := i * 2 - 1. + p < n ifTrue: [p := primes next]. + Sizes at: i put: p] +! ! + +!HashTable class methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +goodPrimes + " + from squeak + " + ^#(269 359 479 641 857 1151 1549 2069 + 2237 2423 2617 2797 2999 3167 3359 3539 3727 3911 + 4441 4787 5119 5471 5801 6143 6521 6827 7177 7517 7853 + 8783 9601 10243 10867 11549 12239 12919 13679 14293 15013 15731 + 17569 19051 20443 21767 23159 24611 25847 27397 28571 30047 31397 + 35771 38201 40841 43973 46633 48989 51631 54371 57349 60139 62969 + 70589 76091 80347 85843 90697 95791 101051 106261 111143 115777 120691 126311 + 140863 150523 160969 170557 181243 190717 201653 211891 221251 232591 242873 251443 + 282089 300869 321949 341227 362353 383681 401411 422927 443231 464951 482033 504011 + 562621 605779 647659 681607 723623 763307 808261 844709 886163 926623 967229 1014617 + 1121987 1201469 1268789 1345651 1429531 1492177 1577839 1651547 1722601 1800377 1878623 1942141 2028401 + 2242727 2399581 2559173 2686813 2836357 3005579 3144971 3283993 3460133 3582923 3757093 3903769 4061261 + 4455361 4783837 5068529 5418079 5680243 6000023 6292981 6611497 6884641 7211599 7514189 7798313 8077189 + 9031853 9612721 10226107 10745291 11338417 11939203 12567671 13212697 13816333 14337529 14938571 15595673 16147291 + 17851577 18993941 20180239 21228533 22375079 23450491 24635579 25683871 26850101 27921689 29090911 30153841 31292507 32467307 + 35817611 37983761 40234253 42457253 44750177 46957969 49175831 51442639 53726417 55954637 58126987 60365939 62666977 64826669 + 71582779 76039231 80534381 84995153 89500331 93956777 98470819 102879613 107400389 111856841 116365721 120819287 125246581 129732203 + 143163379 152076289 161031319 169981667 179000669 187913573 196826447 205826729 214748357 223713691 232679021 241591901 250504801 259470131 + 285162679 301939921 318717121 335494331 352271573 369148753 385926017 402603193 419480419 436157621 453034849 469712051 486589307 503366497 520043707 + 570475349 603929813 637584271 671138659 704693081 738247541 771801929 805356457 838910803 872365267 905919671 939574117 973128521 1006682977 1040137411 + 1073741833) +! ! + +!HashTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self new: 7 +! ! + +!HashTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + | size | + size := self primeFor: anInteger. + ^super new: size +! ! + +!HashTable class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nilToken + ^NilToken +! ! + +!HashTable class methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +primeFor: size + | n primes | + n := size bitOr: 1. + n <= 251 ifTrue: [^Sizes at: n // 2 + 1]. + primes := self goodPrimes. + 1 to: primes size do: [:i | | p | + p := primes at: i. + p > n ifTrue: [^p]]. + ^n +! ! + + diff --git a/modules/Kernel/HashTablePolicy.Class.st b/modules/Kernel/HashTablePolicy.Class.st new file mode 100644 index 00000000..ce03da04 --- /dev/null +++ b/modules/Kernel/HashTablePolicy.Class.st @@ -0,0 +1,151 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #HashTablePolicy category: #Kernel! +Object subclass: #HashTablePolicy + instanceVariableNames: 'associationClass bucketClass maxSlots weak hasher comparison storesAssociations' + classVariableNames: 'EmptySlot' + poolDictionaries: '' + category: 'Kernel'! +!HashTablePolicy commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationClass + ^associationClass +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationClass: aClass + associationClass := aClass +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bucketClass: aClass + bucketClass := aClass +! ! + +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +bucketOfSize: anInteger + | bucket | + bucket := (bucketClass new: anInteger) policy: self. + weak ifTrue: [bucket beWeak]. + ^bucket +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +comparison: evaluableObject + comparison := evaluableObject +! ! + +!HashTablePolicy methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +contentOfSize: anInteger + | table | + table := bucketClass new: anInteger. + table policy: self. + weak ifTrue: [table beWeak]. + ^table +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +emptySlot + ^weak ifTrue: [EmptySlot] +! ! + +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +equates: key with: anObject + | item | + item := storesAssociations ifTrue: [anObject key] ifFalse: [anObject]. + ^comparison isNil + ifTrue: [key = item] + ifFalse: [comparison evaluateWith: key with: item] +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasher: evaluableObject + hasher := evaluableObject +! ! + +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashFor: anObject + ^hasher notNil + ifTrue: [hasher evaluateWith: anObject] + ifFalse: [anObject hash] +! ! + +!HashTablePolicy methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + associationClass := Association. + weak := storesAssociations := false +! ! + +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyFor: anObject + ^storesAssociations ifTrue: [anObject key] ifFalse: [anObject] +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxSlots + ^maxSlots +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxSlots: anInteger + maxSlots := anInteger +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storesAssociations: aBoolean + storesAssociations := aBoolean +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +useIdentityHash + self + hasher: [:key | key basicHash * 16273]; + comparison: [:a :b | a == b] +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +useStringHash + self + hasher: [:key | key stringHash]; + comparison: [:a :b | a equals: b] +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +usesWeakSlots + ^weak +! ! + +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +useWeakSlots + weak := true +! ! + +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +weak: aBoolean + weak := aBoolean +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HashTablePolicy class' category: #Kernel! +HashTablePolicy class + instanceVariableNames: 'EmptySlot'! + +!HashTablePolicy class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +emptySlot + ^EmptySlot +! ! + +!HashTablePolicy class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeEmptySlot + EmptySlot := Object new +! ! + + +HashTablePolicy initialize! + diff --git a/modules/Kernel/HashedCollection.Class.st b/modules/Kernel/HashedCollection.Class.st new file mode 100644 index 00000000..f761a8d0 --- /dev/null +++ b/modules/Kernel/HashedCollection.Class.st @@ -0,0 +1,327 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #HashedCollection category: #Kernel! +Collection subclass: #HashedCollection + instanceVariableNames: 'tally table' + classVariableNames: 'Policies' + poolDictionaries: '' + category: 'Kernel'! +!HashedCollection commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!HashedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: element + (table atKey: element put: element) == nil ifTrue: [self incrementTally]. + ^element +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger + ^self errorNotIndexable +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: anObject + ^self errorNotIndexable +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAdd: element + tally := tally + 1. + table basicAtKey: element put: element. + ^element +! ! + +!HashedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicDo: aBlock + table elementsDo: aBlock count: tally +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +beWeak + | policy | + policy := self policy. + policy == self ifTrue: [policy := self defaultPolicy]. + policy useWeakSlots. + table beWeak. + self usePolicy: policy +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bucketClass + ^OpenHashTable +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +bucketOfSize: anInteger + ^(self bucketClass new: anInteger) owner: self +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +contentOfSize: anInteger + ^self policy == self + ifTrue: [(self bucketClass new: anInteger) owner: self] + ifFalse: [self policy contentOfSize: anInteger] +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +contents + ^table +! ! + +!HashedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copy + | copy | + copy := super copy. + table policy == self ifTrue: [copy useDefaultPolicy] ifFalse: [ + self ASSERT: table policy class == HashTablePolicy. + copy usePolicy: table policy copy]. + ^copy +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultPolicy + ^HashTablePolicy new + storesAssociations: self storesAssociations; + bucketClass: self bucketClass +! ! + +!HashedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + self basicDo: aBlock +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +emptySlot + ^nil +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +equates: key with: element + ^key = element +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +grow + self resizeTo: tally * 2 +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashFor: anObject + ^anObject hash +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +incrementTally + tally := tally + 1. + (table isCapacityGreaterThan: tally) ifFalse: [self grow] +! ! + +!HashedCollection methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize: anInteger + | t | + t := self contentOfSize: anInteger. + self onTable: t +! ! + +!HashedCollection methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeWeakSize: anInteger + self initialize: anInteger. + table beWeak +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyFor: anObject + ^anObject +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxSlots + ^self policy == self ifFalse: [self policy maxSlots] +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxSlots: anInteger + | policy | + policy := self policy. + policy == self ifTrue: [policy := self defaultPolicy]. + policy maxSlots: anInteger. + self usePolicy: policy +! ! + +!HashedCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +occurrencesOf: anObject + ^(self includes: anObject) ifTrue: [1] ifFalse: [0] +! ! + +!HashedCollection methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +onTable: aHashTable + tally := 0. + table := aHashTable +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +policy + ^table notNil ifTrue: [table policy] ifFalse: [self] +! ! + +!HashedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +postCopy + super postCopy. + table := table copy +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +rehash + tally isNil ifTrue: [tally := table count]. + self resizeTo: tally +! ! + +!HashedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: anObject ifAbsent: aBlock + table removeKey: anObject ifAbsent: [^aBlock value]. + tally := tally - 1. + ^anObject +! ! + +!HashedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAll + tally = 0 ifTrue: [^self]. + table removeAll. + tally := 0 +! ! + +!HashedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAll: aCollection + ^self removeAll: aCollection ifAbsent: [self errorNotFound] +! ! + +!HashedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAll: aCollection ifAbsent: aBlock + | n | + n := aCollection size. + table removeKeys: aCollection ifAbsent: [ + n := n - 1. + aBlock value]. + tally := tally - n. + ^aCollection +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +resizeTo: anInteger + | copy t policy n | + n := self class sizeFor: anInteger. + t := self contentOfSize: n. + copy := self class on: t. + policy := self policy. + policy == self ifFalse: [ + self ASSERT: policy class == HashTablePolicy. + copy usePolicy: policy copy]. + self rebuildOn: copy. + policy == self ifTrue: [table policy: self] ifFalse: [table policy: policy] +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^tally +! ! + +!HashedCollection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storesAssociations + ^false +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +table + ^table +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +useDefaultPolicy + table policy == self ifTrue: [^self]. + table policy: self. + self notEmpty ifTrue: [self rehash] +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +useIdentityHash + | policy | + policy := self defaultPolicy. + policy useIdentityHash. + self usePolicy: policy +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +usePolicy: aHashTablePolicy + table isNil ifTrue: [^self]. + table policy: aHashTablePolicy. + aHashTablePolicy usesWeakSlots + ifTrue: [self class registerPolicy: aHashTablePolicy for: self]. + self notEmpty ifTrue: [self rehash] +! ! + +!HashedCollection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +usesWeakSlots + | p | + p := self policy. + ^p !!== self and: [p usesWeakSlots] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HashedCollection class' category: #Kernel! +HashedCollection class + instanceVariableNames: 'Policies'! + +!HashedCollection class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializePolicies + Policies := WeakIdentityDictionary new +! ! + +!HashedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self new: 5 +! ! + +!HashedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + | size | + size := self sizeFor: anInteger. + ^self basicNew initialize: size +! ! + +!HashedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger using: aHashedCollectionPolicy + | size | + size := self sizeFor: anInteger. + ^self basicNew + onTable: (aHashedCollectionPolicy contentOfSize: size); + usePolicy: aHashedCollectionPolicy +! ! + +!HashedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aHashTable + ^self new onTable: aHashTable +! ! + +!HashedCollection class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +registerPolicy: aHashTablePolicy for: aHashedCollection + Policies at: aHashedCollection put: aHashTablePolicy +! ! + +!HashedCollection class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeFor: anInteger + ^7 max: anInteger * 3 // 2 +! ! + +!HashedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: aCollection + | instance | + instance := self new: aCollection size. + ^instance addAll: aCollection; yourself +! ! + + diff --git a/modules/Kernel/HostSystem.Class.st b/modules/Kernel/HostSystem.Class.st new file mode 100644 index 00000000..39cb6d62 --- /dev/null +++ b/modules/Kernel/HostSystem.Class.st @@ -0,0 +1,224 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #HostSystem category: #Kernel! +Object subclass: #HostSystem + instanceVariableNames: 'searchPaths' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!HostSystem commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimas. + See (MIT) license in root directory. +! + +!HostSystem methodsFor: 'search paths' stamp: 'KenD 28/Jun/2026 13:27:38'! +addSearchPath: aString type: aSymbol + "Append a search path. aSymbol is #ems or #tonel." + self searchPaths add: aString -> aSymbol +! ! + +!HostSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +createDirectory: aString + +! ! + +!HostSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +currentDirectory + +! ! + +!HostSystem methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +currentMilliseconds + +! ! + +!HostSystem methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +exit: anInteger + +! ! + +!HostSystem methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:38'! +fixOverrides + +! ! + +!HostSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +getEnv: aString + +! ! + +!HostSystem methodsFor: 'search paths' stamp: 'KenD 28/Jun/2026 13:27:38'! +homeDirectory + ^self isWindows + ifTrue: [self getEnv: 'USERPROFILE'] + ifFalse: [self getEnv: 'HOME'] +! ! + +!HostSystem methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeFFI: anExternalLibrary symbolFinder: anFFIMethod + +! ! + +!HostSystem methodsFor: 'search paths' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWindows + ^(self platformName indexOfSubcollection: 'win32') > 0 +! ! + +!HostSystem methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:38'! +load: aSymbol + "Search configured paths for a module named aSymbol. Each search path is + an association `path -> type` where type is #ems (binary segment file) or + #tonel (sources directory)." + | relative | + relative := self pathFor: aSymbol. + searchPaths ifNil: [^nil]. + searchPaths do: [:assoc | | base type candidate | + base := assoc key. + type := assoc value. + candidate := type = #ems + ifTrue: [base , '/' , relative , '.ems'] + ifFalse: [base , '/' , relative]. + (self pathExists: candidate) ifTrue: [ + ^self loadModuleFromPath: candidate]]. + ^nil +! ! + +!HostSystem methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:38'! +loadModuleFromPath: aString + | module | + module := self primitiveLoadModuleFromPath: aString. + ^module justLoaded +! ! + +!HostSystem methodsFor: 'logging' stamp: 'KenD 28/Jun/2026 13:27:38'! +log: aString level: anInteger + +! ! + +!HostSystem methodsFor: 'logging' stamp: 'KenD 28/Jun/2026 13:27:38'! +logDebug: aString + self log: aString level: 1 +! ! + +!HostSystem methodsFor: 'logging' stamp: 'KenD 28/Jun/2026 13:27:38'! +logError: aString + self log: aString level: 4 +! ! + +!HostSystem methodsFor: 'logging' stamp: 'KenD 28/Jun/2026 13:27:38'! +logFatal: aString + self log: aString level: 5 +! ! + +!HostSystem methodsFor: 'logging' stamp: 'KenD 28/Jun/2026 13:27:38'! +logInfo: aString + self log: aString level: 2 +! ! + +!HostSystem methodsFor: 'logging' stamp: 'KenD 28/Jun/2026 13:27:38'! +logTrace: aString + self log: aString level: 0 +! ! + +!HostSystem methodsFor: 'logging' stamp: 'KenD 28/Jun/2026 13:27:38'! +logWarning: aString + self log: aString level: 3 +! ! + +!HostSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +pathExists: aString + +! ! + +!HostSystem methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:38'! +pathFor: aSymbol + ^aSymbol asString replaceAll: '.' with: '/' +! ! + +!HostSystem methodsFor: 'search paths' stamp: 'KenD 28/Jun/2026 13:27:38'! +pathSeparator + "Separator used by the host OS in PATH-like environment variables." + ^self isWindows ifTrue: [$;] ifFalse: [$:] +! ! + +!HostSystem methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:38'! +platformName + +! ! + +!HostSystem methodsFor: 'search paths' stamp: 'KenD 28/Jun/2026 13:27:38'! +prependSearchPath: aString type: aSymbol + self searchPaths addFirst: aString -> aSymbol +! ! + +!HostSystem methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveLoad: aSymbol + | error | + + ^Error signal: error +! ! + +!HostSystem methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveLoadModuleFromPath: aString + | error | + + ^Error signal: error +! ! + +!HostSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +readFile: filename + +! ! + +!HostSystem methodsFor: 'search paths' stamp: 'KenD 28/Jun/2026 13:27:38'! +searchPaths + "Ordered collection of associations `path -> type` (#ems or #tonel)." + ^searchPaths ifNil: [searchPaths := OrderedCollection new] +! ! + +!HostSystem methodsFor: 'search paths' stamp: 'KenD 28/Jun/2026 13:27:38'! +setupDefaultSearchPaths + "Configure default search paths. EGG_MODULES_PATH (paths separated by the + platform-native PATH separator) supplies extra source directories. We also + walk a few levels up from the current directory so the runtime works both + from the project root and from a build subdirectory." + | env home prefixes | + env := self getEnv: 'EGG_MODULES_PATH'. + env ifNotNil: [ + (env substringsSplitBy: self pathSeparator) do: [:p | + self addSearchPath: p type: #tonel. + self addSearchPath: p type: #ems]]. + prefixes := #('' '../' '../../' '../../../' '../../../../'). + prefixes do: [:p | | base | + base := p , 'modules'. + (self pathExists: base) ifTrue: [ + self addSearchPath: base type: #tonel. + self addSearchPath: base type: #ems]]. + home := self homeDirectory. + home ifNotNil: [ + self addSearchPath: home , '/.egg/cache/modules' type: #ems]. + self isWindows ifFalse: [ + self addSearchPath: '/usr/local/share/egg/modules' type: #tonel. + self addSearchPath: '/usr/local/share/egg/modules' type: #ems] +! ! + +!HostSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +suspended: aProcess because: anException + self + logError: 'Error: ' , anException description; + exit: 1 +! ! + +!HostSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +writeFile: aFilename contents: aString + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HostSystem class' category: #Kernel! +HostSystem class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/IdentityDictionary.Class.st b/modules/Kernel/IdentityDictionary.Class.st new file mode 100644 index 00000000..604e4752 --- /dev/null +++ b/modules/Kernel/IdentityDictionary.Class.st @@ -0,0 +1,36 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #IdentityDictionary category: #Kernel! +InlinedDictionary subclass: #IdentityDictionary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!IdentityDictionary commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!IdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +equates: key1 with: key2 + ^key1 == key2 +! ! + +!IdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashFor: object + ^object basicHash * 16273 +! ! + +!IdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyCollector + ^IdentitySet new: self size +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IdentityDictionary class' category: #Kernel! +IdentityDictionary class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/IdentitySet.Class.st b/modules/Kernel/IdentitySet.Class.st new file mode 100644 index 00000000..c0b86d95 --- /dev/null +++ b/modules/Kernel/IdentitySet.Class.st @@ -0,0 +1,36 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #IdentitySet category: #Kernel! +Set subclass: #IdentitySet + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!IdentitySet commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!IdentitySet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +equates: key with: element + ^key == element +! ! + +!IdentitySet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashFor: object + ^object basicHash * 16273 +! ! + +!IdentitySet methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +includesIdentical: anObject + ^self includes: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IdentitySet class' category: #Kernel! +IdentitySet class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/ImageSegment.Class.st b/modules/Kernel/ImageSegment.Class.st new file mode 100644 index 00000000..8f6d69e4 --- /dev/null +++ b/modules/Kernel/ImageSegment.Class.st @@ -0,0 +1,37 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ImageSegment category: #Kernel! +Object subclass: #ImageSegment + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ImageSegment commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ImageSegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name + ^name +! ! + +!ImageSegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name: aString + name := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ImageSegment class' category: #Kernel! +ImageSegment class + instanceVariableNames: ''! + +!ImageSegment class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +load: filename + "TO BE IMPLEMENTED!!" + ^nil +! ! + + diff --git a/modules/Kernel/InlinedDictionary.Class.st b/modules/Kernel/InlinedDictionary.Class.st new file mode 100644 index 00000000..b3556eb5 --- /dev/null +++ b/modules/Kernel/InlinedDictionary.Class.st @@ -0,0 +1,109 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #InlinedDictionary category: #Kernel! +Dictionary subclass: #InlinedDictionary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!InlinedDictionary commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!InlinedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationAt: key ifAbsent: exceptionBlock + | value | + value := table lookupValue: key ifAbsent: [^exceptionBlock value]. + ^self associationClass key: key value: value +! ! + +!InlinedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationsDo: aBlock + table keysAndValuesDo: [:key :value | | assoc | + assoc := Association key: key value: value. + aBlock evaluateWith: assoc] +! ! + +!InlinedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: key put: element + (table atKey: key put: element) == nil ifTrue: [self incrementTally]. + ^element +! ! + +!InlinedDictionary methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAdd: anAssociation + self at: anAssociation key put: anAssociation value. + ^anAssociation +! ! + +!InlinedDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +bucketClass + ^InlinedHashTable +! ! + +!InlinedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + table keysAndValuesDo: [:key :value | aBlock evaluateWith: value] +! ! + +!InlinedDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +equates: key with: element + ^key = element +! ! + +!InlinedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: element ifAbsent: aBlock + self keysAndValuesDo: [:key :value | value = element ifTrue: [^key]]. + ^aBlock value +! ! + +!InlinedDictionary methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyAtValue: anObject ifAbsent: aBlock + 1 to: table size by: 2 do: [:index | + (table at: index + 1) = anObject + ifTrue: [(table at: index) ifNotNil: [:k | ^k]]]. + ^aBlock value +! ! + +!InlinedDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyFor: anObject + ^anObject +! ! + +!InlinedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +keysAndElementsDo: aBlock + self keysAndValuesDo: aBlock +! ! + +!InlinedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +keysAndValuesDo: aBlock + table keysAndValuesDo: aBlock +! ! + +!InlinedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +keysDo: aBlock + table keysAndValuesDo: [:key :value | aBlock evaluateWith: key] +! ! + +!InlinedDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +storesAssociations + ^false +! ! + +!InlinedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +values + | values | + values := Bag new. + self do: [:element | values add: element]. + ^values +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlinedDictionary class' category: #Kernel! +InlinedDictionary class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/InlinedHashTable.Class.st b/modules/Kernel/InlinedHashTable.Class.st new file mode 100644 index 00000000..929772c0 --- /dev/null +++ b/modules/Kernel/InlinedHashTable.Class.st @@ -0,0 +1,155 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #InlinedHashTable category: #Kernel! +HashTable subclass: #InlinedHashTable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!InlinedHashTable commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!InlinedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index key: key put: element + (self at: index) ifNil: [ + self + at: index put: key; + at: index + 1 put: element. + ^nil]. + self at: index + 1 put: element. + ^key +! ! + +!InlinedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atKey: key hash: hash sum: magnitude + | index v k | + index := self indexOfKey: key hash: hash. + k := self at: index. + (k == nil or: [k == self emptySlot]) ifFalse: [ + v := (self at: index + 1) + magnitude. + self at: index + 1 put: v. + ^v]. + self + at: index put: key; + at: index + 1 put: magnitude. + ^nil +! ! + +!InlinedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAtKey: key put: element + | index | + index := self indexOfKey: key. + self + at: index put: key; + at: index + 1 put: element +! ! + +!InlinedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +clearSlot: anInteger with: emptySlot + self + basicAt: anInteger put: emptySlot; + basicAt: anInteger + 1 put: emptySlot +! ! + +!InlinedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyFromBucket: bucket + | count | + count := 0. + bucket keysAndValuesDo: [:key :value | + count := count + 1. + self basicAtKey: key put: value]. + ^count +! ! + +!InlinedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +count + | n empty | + n := 0. + empty := self emptySlot. + 1 to: self size by: 2 do: [:i | | k | + k := self at: i. + (k == nil or: [k == empty]) ifFalse: [n := n + 1]]. + ^n +! ! + +!InlinedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +elementsDo: aBlock count: n + | count | + count := 0. + self keysAndValuesDo: [:k :v | | assoc | + assoc := Association key: k value: v. + aBlock evaluateWith: assoc. + count := count + 1. + count = n ifTrue: [^self]] +! ! + +!InlinedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfHash: integer + ^integer \\ (self size // 2) * 2 + 1 +! ! + +!InlinedHashTable methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCapacityGreaterThan: count + ^self size * 3 > (count * 8) +! ! + +!InlinedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +keysAndValuesDo: aBlock + 1 to: self size by: 2 do: [:index | | key value | + key := self at: index. + key notNil ifTrue: [ + key := key == NilToken ifFalse: [key]. + value := self at: index + 1. + value := value == NilToken ifFalse: [value]. + aBlock value: key value: value]] +! ! + +!InlinedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookupValue: key + ^self lookupValue: key ifAbsent: [self keyNotFound: key] +! ! + +!InlinedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +moveSlot: anInteger to: targetInteger + | k v empty | + empty := self emptySlot. + k := self basicAt: anInteger. + v := self basicAt: anInteger + 1. + self + basicAt: anInteger put: empty; + basicAt: anInteger + 1 put: empty; + basicAt: targetInteger put: k; + basicAt: targetInteger + 1 put: v +! ! + +!InlinedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +slotsPerElement + ^2 +! ! + +!InlinedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueAt: index ifAbsent: aBlock + | k value | + k := self at: index. + (k == nil or: [k == self emptySlot]) ifTrue: [^aBlock value]. + value := self at: index + 1. + ^value == NilToken ifFalse: [value] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlinedHashTable class' category: #Kernel! +InlinedHashTable class + instanceVariableNames: ''! + +!InlinedHashTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + | n | + n := self primeFor: anInteger. + ^self basicNew: n * 2 +! ! + + diff --git a/modules/Kernel/Integer.Class.st b/modules/Kernel/Integer.Class.st new file mode 100644 index 00000000..2ffaaa73 --- /dev/null +++ b/modules/Kernel/Integer.Class.st @@ -0,0 +1,549 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Integer category: #Kernel! +Number subclass: #Integer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Integer commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +/ aNumber + | gcd | + aNumber isInteger ifFalse: [^aNumber reciprocal * self]. + gcd := self gcd: aNumber. + ^gcd = aNumber abs + ifTrue: [self // aNumber] + ifFalse: [Fraction numerator: self // gcd denominator: aNumber // gcd] +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +<< bits + bits < 0 ifTrue: [self error: 'negative arg']. + ^self bitShift: bits +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +>> bits + bits < 0 ifTrue: [self error: 'negative arg']. + ^self bitShift: 0 - bits +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +alignedTo: anInteger + ^self + anInteger - 1 // anInteger * anInteger +! ! + +!Integer methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +anyMask: bits + ^(self bitAnd: bits) !!= 0 +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asBoolean + ^self !!= 0 +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asByteArray + | size array | + size := self sizeInBytes. + array := ByteArray new: size. + ^array replaceFrom: 1 to: size with: self startingAt: 1 +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asCharacter + ^Character value: self +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asFloat + ^Float fromInteger: self +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asFraction + ^self +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asInteger + ^self +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asLong + ^ByteArray fromBytes: self length: 4 +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asScaledDecimal + " + 17 asScaledDecimal + " + ^ScaledDecimal fromNumber: self scale: 0 +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asShort + | ushort | + ushort := self bitAnd: 16rFFFF. + ushort > 16r7FFF ifTrue: [ushort := ushort - 16r10000]. + ^ushort +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asUnsigned + ^self positive + ifTrue: [self] + ifFalse: [self asExternalPointer asUnsignedInteger] +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +benchFibonacci + " + Handy send-heavy benchmark + (result // seconds to run) = approx calls per second + | r t | + t := Time millisecondsToRun: [r := 26 benchFib]. + (r * 1000) // t + 138000 on a Mac 8100/100 + " + ^self < 2 + ifTrue: [1] + ifFalse: [(self - 1) benchFibonacci + (self - 2) benchFibonacci + 1] +! ! + +!Integer methodsFor: 'benchmarking' stamp: 'KenD 28/Jun/2026 13:27:38'! +benchSieve + " + Bytecode heavy benchmark + (500000 // time to run) = approx bytecodes per second + 5000000 // (Time millisecondsToRun: [10 benchSieve]) * 1000 + 3059000 on a Mac 8100/100 + " + | size flags prime k count | + size := 8190. + 1 to: self do: [:iter | + count := 0. + flags := (Array new: size) atAllPut: true. + 1 to: size do: [:i | + (flags at: i) ifTrue: [ + prime := i + 1. + k := i + prime. + [k <= size] whileTrue: [ + flags at: k put: false. + k := k + prime]. + count := count + 1]]]. + ^count +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitAt: anInteger + ^self >= 0 + ifTrue: [1 bitAnd: (self bitShift: 1 - anInteger)] + ifFalse: [1 - (1 bitAnd: (self bitInvert bitShift: 1 - anInteger))] +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitClear: mask + " + (2r111100110 bitClear: 2r111100) = 2r111000010 + " + ^self bitAnd: mask bitInvert +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitInvert + ^-1 - self +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitsAt: aStretch + " + (2r001101010 bitField: (3 thru: 6)) bin = '1010' + (-16r40000000 bitField: (29 thru: 31)) bin = '100' + " + | shifted mask | + shifted := self bitShiftRight: aStretch start - 1. + mask := 1 bitShift: aStretch length. + ^shifted bitAnd: mask - 1 +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitsAt: aStretch put: anInteger + " + ((2r001101100 bitsAt: (3 thru: 6) put: 2r1101) bitField: (3 thru: 6)) bin = '1101' + ((2r100 bitsAt: (29 thru: 31) put: 2r101) bitField: (29 thru: 31)) bin = '101' + ((2r100 bitsAt: (29 thru: 31) put: 2r101) bitField: (1 thru: 3)) bin = '100' + " + | shifted max | + shifted := anInteger bitShift: aStretch start - 1. + max := 1 bitShift: aStretch length. + anInteger < max ifFalse: [self error: 'invalid argument']. + ^(self bitsClear: aStretch) bitOr: shifted +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitsClear: aStretch + " + (2r111100110 bitsClear: (3 thru: 6)) = 2r111000010 + " + | mask | + mask := (1 bitShift: aStretch end) - (1 bitShift: aStretch start - 1). + ^self bitAnd: mask bitInvert +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitShift: anInteger + | factor | + factor := 2 raisedToInteger: anInteger abs. + ^anInteger positive ifTrue: [self * factor] ifFalse: [self // factor] +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitShiftRight: anInteger + ^self bitShift: 0 - anInteger +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +ceiling + ^self +! ! + +!Integer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +coerce: aNumber + ^aNumber asInteger +! ! + +!Integer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +digitsBase: anInteger + " + 12345 digitsBase: 1 + " + | remainders quo char n digits | + remainders := OrderedCollection new: 20. + quo := self abs. + [anInteger <= quo] whileTrue: [ + char := Character digitValue: quo \\ anInteger. + remainders add: char. + quo := quo // anInteger]. + char := Character digitValue: quo. + remainders add: char. + n := remainders size. + digits := Array new: n. + 1 to: n do: [:i | digits at: i put: (remainders at: n - i + 1)]. + ^digits +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +factorial + self > 1 ifTrue: [^(self - 1) factorial * self]. + self < 0 ifTrue: [^self error: 'not valid for negative numbers']. + ^1 +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +floor + ^self +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +gbytes + ^self mbytes * 1024 +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +gcd: anInteger + " + See Knuth, Vol 2, 4.5.2, Algorithm L + " + | higher u v k uHat vHat a b c d vPrime vPrimePrime q t | + higher := SmallInteger maximum highBit. + u := self abs max: (v := anInteger abs). + v := self abs min: v. + [v class == SmallInteger] whileFalse: [ + (uHat := u bitShift: (k := higher - u highBit)) class == SmallInteger + ifFalse: [ + k := k - 1. + uHat := uHat bitShift: -1]. + vHat := v bitShift: k. + a := d := 1. + b := c := 0. + [ + (vPrime := vHat + d) ~= 0 and: [ + (vPrimePrime := vHat + c) ~= 0 + and: [(q := uHat + a // vPrimePrime) = (uHat + b // vPrime)]]] + whileTrue: [ + c := a - (q * (a := c)). + d := b - (q * (b := d)). + vHat := uHat - (q * (uHat := vHat))]. + b = 0 ifTrue: [v := u rem: (u := v)] ifFalse: [ + t := u * a + (v * b). + v := u * c + (v * d). + u := t]]. + ^v gcd: u +! ! + +!Integer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashMultiply + ^(self bitAnd: 16rFFFFFFF) hashMultiply +! ! + +!Integer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +highWord + ^(self bitAnd: 16rFFFFFFFF) bitShift: -16 +! ! + +!Integer methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isInteger + ^true +! ! + +!Integer methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isOnBit: n + ^(self bitAnd: n) = n +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +kbytes + ^self * 1024 +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +lcm: anInteger + | gcd | + gcd := self gcd: anInteger. + ^gcd = 0 ifTrue: [1] ifFalse: [(self // gcd * anInteger) abs] +! ! + +!Integer methodsFor: 'bit operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +low32 + ^self bitAnd: 0xFFFFFFFF +! ! + +!Integer methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +lowBit + | count mask | + self = 0 ifTrue: [^nil]. + count := mask := 1. + [self isOnBit: mask] whileFalse: [ + mask := mask bitShift: 1. + count := count + 1]. + ^count +! ! + +!Integer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lowWord + ^self bitAnd: 16rFFFF +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +mbytes + ^self kbytes * 1024 +! ! + +!Integer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +oct + " + 255 oct + " + ^self radix: 8 +! ! + +!Integer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printDigitsOn: aStream base: anInteger + self printDigitsOn: aStream base: anInteger paddedTo: 0 with: $0 +! ! + +!Integer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printDigitsOn: aStream base: bInteger paddedTo: dInteger with: aCharacter + | digits | + self < 0 ifTrue: [ + aStream nextPut: $-. + ^self negated printOn: aStream base: bInteger]. + digits := self digitsBase: bInteger. + (dInteger - digits size max: 0) timesRepeat: [aStream nextPut: aCharacter]. + digits do: [:char | aStream nextPut: char] +! ! + +!Integer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream base: anInteger + self printOn: aStream base: anInteger paddedTo: 0 +! ! + +!Integer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream base: bInteger paddedTo: dInteger + self printOn: aStream base: bInteger paddedTo: dInteger with: $0 +! ! + +!Integer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream base: bInteger paddedTo: dInteger with: aCharacter + self < 0 ifTrue: [ + aStream nextPut: $-. + ^self negated printOn: aStream base: bInteger]. + bInteger = 10 ifFalse: [ + bInteger = 16 ifTrue: [aStream nextPutAll: '0x'] ifFalse: [ + bInteger printDigitsOn: aStream base: 10. + aStream nextPut: $r]]. + self + printDigitsOn: aStream + base: bInteger + paddedTo: dInteger + with: aCharacter +! ! + +!Integer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printPaddedTo: anInteger + ^self printPaddedWith: $ to: anInteger base: 10 +! ! + +!Integer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printPaddedWith: aCharacter to: anInteger + " + 0 printPaddedWith: $0 to: 2 + " + ^self + printPaddedWith: aCharacter + to: anInteger + base: 10 +! ! + +!Integer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printPaddedWith: aCharacter to: anInteger base: radix + ^String + streamContents: [:strm | self + printDigitsOn: strm + base: radix + paddedTo: anInteger + with: aCharacter] +! ! + +!Integer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +radix: anInteger + | digits | + digits := self digitsBase: anInteger. + ^String withAll: digits +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +reciprocal + ^1 / self +! ! + +!Integer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reduced + ^self +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +rem: aNumber + aNumber = 0 ifTrue: [^self zeroDivisorOn: #rem:]. + ^super rem: aNumber +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +rounded + ^self +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +sqrt + | float guess | + float := self asFloat sqrt. + float isInfinite ifFalse: [ + guess := float truncated. + guess squared = self ifTrue: [^guess]]. + ^float +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +sqrtFloor + | guess square delta | + guess := 1 bitShift: self highBit + 1 // 2. + [ + square := guess * guess. + delta := square - self // (guess bitShift: 1). + delta = 0] + whileFalse: [guess := guess - delta]. + square = self ifFalse: [guess := guess - 1]. + ^guess +! ! + +!Integer methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +strictlyPositive + ^self > 0 +! ! + +!Integer methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +thru: anInteger + ^Stretch from: self thru: anInteger +! ! + +!Integer methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +timesRepeat: aBlock + | n | + n := 1. + [n <= self] whileTrue: [ + aBlock value. + n := n + 1] +! ! + +!Integer methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncated + ^self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Integer class' category: #Kernel! +Integer class + instanceVariableNames: ''! + +!Integer class methodsFor: 'inspecting' stamp: 'KenD 28/Jun/2026 13:27:38'! +aspects + ^#(#hex #bin #oct) +! ! + +!Integer class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString + ^self readFrom: aString readStream +! ! + +!Integer class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +readFrom: aStream + | pos value string | + pos := aStream position. + value := NumberParser new on: aStream; nextValue. + value isInteger ifTrue: [^value]. + aStream position: pos. + string := aStream throughAll: '.'. + (string endsWith: '.') ifTrue: [aStream skip: -1]. + ^NumberParser new on: string; nextValue +! ! + +!Integer class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +readFrom: aStream radix: radix + | integer positive digit | + integer := 0. + positive := aStream peekFor: $+. + positive ifFalse: [positive := (aStream peekFor: $-) not]. + [| char | + char := aStream peek. + char notNil and: [ + (char isDigit or: [char isLetter]) and: [ + digit := char digitValue. + digit < radix]]] + whileTrue: [ + integer := integer * radix + digit. + aStream next]. + ^positive ifTrue: [integer] ifFalse: [integer negated] +! ! + + diff --git a/modules/Kernel/InternalReadStream.Class.st b/modules/Kernel/InternalReadStream.Class.st new file mode 100644 index 00000000..eaab8fe5 --- /dev/null +++ b/modules/Kernel/InternalReadStream.Class.st @@ -0,0 +1,318 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #InternalReadStream category: #Kernel! +ReadStream subclass: #InternalReadStream + instanceVariableNames: 'contents position limit eol' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!InternalReadStream commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!InternalReadStream methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asPetitStream + ^contents asPetitStream +! ! + +!InternalReadStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atEnd + ^limit <= position +! ! + +!InternalReadStream methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:38'! +beWide + self isWide ifTrue: [^self]. + contents := contents asWideString. + eol := eol asWideString +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterSize + ^contents isString ifTrue: [contents characterSize] ifFalse: [1] +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +collection + ^contents +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +collectorClass + ^contents class +! ! + +!InternalReadStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +collectorOfSize: anInteger + | collector | + collector := contents class new: anInteger. + collector size < anInteger + ifTrue: [collector addAll: (Array new: anInteger - collector size)]. + ^collector +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +contents + ^contents +! ! + +!InternalReadStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +eol + ^eol +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +eol: aString + eol := aString +! ! + +!InternalReadStream methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + eol := ' +' +! ! + +!InternalReadStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBinary + ^contents isByteArray +! ! + +!InternalReadStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmpty + ^self size = 0 +! ! + +!InternalReadStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWide + ^contents isString and: [contents isWideString] +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lineDelimiter + ^eol first +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lineDelimiter: aCharacter + eol := (aCharacter isCharacter and: [aCharacter isCr]) + ifTrue: [aCharacter , aCharacter class lf] + ifFalse: [aCharacter asString] +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lineDelimiters: aString + self lineDelimiter: aString +! ! + +!InternalReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +next + limit notNil ifTrue: [ + position < limit ifFalse: [self readingError]. + position := position + 1. + ^contents at: position]. + position := position + 1. + ^contents at: position ifAbsent: [ + position := position - 1. + self readingError] +! ! + +!InternalReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +next: n + | end result | + end := position + n. + ^end > limit + ifTrue: [ + position := limit. + self readingError] + ifFalse: [ + result := contents copyFrom: position + 1 to: end. + position := end. + result] +! ! + +!InternalReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextByte + self atEnd ifTrue: [self readingError]. + position := position + 1. + ^contents byteAt: position +! ! + +!InternalReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextLine + | delimiter line | + delimiter := eol first. + line := self upTo: delimiter. + delimiter = Cr ifTrue: [self peekFor: Lf]. + ^line +! ! + +!InternalReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextOrNil + ^self atEnd ifFalse: [ + position := position + 1. + contents at: position] +! ! + +!InternalReadStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextULong + (self isBinary or: [contents class == String]) ifTrue: [ + position := position + 4. + position > limit ifTrue: [ + position := limit. + self readingError]. + ^contents uLongAtOffset: position - 4]. + ^super nextULong +! ! + +!InternalReadStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aCollection + contents := aCollection. + position := 0. + limit := contents size. + aCollection isString ifTrue: [self updateEol] +! ! + +!InternalReadStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aCollection from: anInteger to: anotherInteger + | n | + contents := aCollection. + n := contents size. + limit := anotherInteger min: n. + position := anInteger <= 1 ifTrue: [0] ifFalse: [anInteger - 1] +! ! + +!InternalReadStream methodsFor: 'peeking' stamp: 'KenD 28/Jun/2026 13:27:38'! +peek + ^self atEnd ifFalse: [contents at: position + 1] +! ! + +!InternalReadStream methodsFor: 'peeking' stamp: 'KenD 28/Jun/2026 13:27:38'! +peekFor: token + | found | + found := self peek = token. + found ifTrue: [position := position + 1]. + ^found +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +position + ^position +! ! + +!InternalReadStream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +position: anInteger + position := anInteger +! ! + +!InternalReadStream methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +readInto: aByteArray from: start to: stop + | end | + end := position + stop - start + 1. + end > limit ifTrue: [^self readingError]. + aByteArray + replaceBytesFrom: start + to: stop + with: contents + startingAt: position + 1. + position := end. + ^aByteArray +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +readLimit: anInteger + limit := anInteger +! ! + +!InternalReadStream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +setToEnd + limit := contents size. + position := self size +! ! + +!InternalReadStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^limit +! ! + +!InternalReadStream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +skipTo: token + | index | + index := contents + indexOf: token + startingAt: position + 1 + ifAbsent: [^super skipTo: token]. + self skip: index - position. + ^true +! ! + +!InternalReadStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +updateEol + eol := contents eol ifNil: [String with: Cr] +! ! + +!InternalReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +upTo: token + | pos found offset | + pos := position. + found := self skipTo: token. + offset := found ifTrue: [1] ifFalse: [0]. + ^contents copyFrom: pos + 1 to: position - offset +! ! + +!InternalReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToAll: aCollection + " + (InternalReadStream on: 'Smalltalk') upToAll: 'al' + " + aCollection size > 1 + ifTrue: [^self upToAll: aCollection td1: aCollection td1]. + aCollection size = 0 ifTrue: [^self upToEnd]. + ^self upTo: aCollection first +! ! + +!InternalReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToAll: aCollection td1: td1 + " + 'hola' readStream upToAll: 'ol' td1: 'ol' td1 + " + | index string | + index := contents + indexOfSubcollection: aCollection + from: position + 1 + to: limit + td1: td1. + index = 0 ifTrue: [^self upToEnd]. + string := self next: index - position - 1. + self skip: aCollection size. + ^string +! ! + +!InternalReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToSeparator + | writer ch | + writer := InternalWriteStream on: self newCollector. + [ + self atEnd or: [ + ch := self next. + ch isBlank]] + whileFalse: [writer nextPut: ch]. + ^writer contents +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InternalReadStream class' category: #Kernel! +InternalReadStream class + instanceVariableNames: ''! + +!InternalReadStream class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aCollection from: anInteger to: anotherInteger + ^self new on: aCollection from: anInteger to: anotherInteger +! ! + + +InternalReadStream initialize! + diff --git a/modules/Kernel/InternalWriteStream.Class.st b/modules/Kernel/InternalWriteStream.Class.st new file mode 100644 index 00000000..b85dc035 --- /dev/null +++ b/modules/Kernel/InternalWriteStream.Class.st @@ -0,0 +1,348 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #InternalWriteStream category: #Kernel! +WriteStream subclass: #InternalWriteStream + instanceVariableNames: 'contents position limit eol size' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!InternalWriteStream commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!InternalWriteStream methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +_nextNativePut: anObject + | object | + object := anObject isSmallInteger + ifTrue: [anObject _asNative] + ifFalse: [anObject]. + contents _objectAtOffset: position put: object. + position := position + WordSize +! ! + +!InternalWriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +alignTo: boundary + | null | + null := self collectorOfSize: boundary - (position \\ boundary). + self nextPutAll: null +! ! + +!InternalWriteStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atEnd + ^limit <= position +! ! + +!InternalWriteStream methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:38'! +beWide + self isWide ifTrue: [^self]. + contents := contents asWideString. + eol := eol asWideString +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterSize + ^contents isString ifTrue: [contents characterSize] ifFalse: [1] +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +collection + ^contents +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +collectorClass + ^contents class +! ! + +!InternalWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +collectorOfSize: anInteger + | collector | + collector := contents class new: anInteger. + collector size < anInteger + ifTrue: [collector addAll: (Array new: anInteger - collector size)]. + ^collector +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +contents + ^contents copyFrom: 1 to: size +! ! + +!InternalWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +eol + eol notNil ifTrue: [^eol]. + ^super eol +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +eol: aString + eol := aString +! ! + +!InternalWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +grow + | min max | + min := contents size max: 20. + max := min min: 1000000. + self grow: max +! ! + +!InternalWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +grow: extra + | collection | + extra <= 0 ifTrue: [^self]. + collection := self collectorOfSize: contents size + extra. + collection replaceFrom: 1 to: contents size with: contents. + contents := collection. + limit := contents size +! ! + +!InternalWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +growAtLeast: extra + self grow: (contents size * 2 max: extra) + 10 +! ! + +!InternalWriteStream methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + self useCr +! ! + +!InternalWriteStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBinary + ^contents isByteArray +! ! + +!InternalWriteStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmpty + ^self size = 0 +! ! + +!InternalWriteStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWide + ^contents isString and: [contents isWide] +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lineDelimiter + ^eol first +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lineDelimiter: aCharacter + eol := (aCharacter isCharacter and: [aCharacter isCr]) + ifTrue: [aCharacter , aCharacter class lf] + ifFalse: [aCharacter asString] +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +lineDelimiters: aString + self lineDelimiter: aString +! ! + +!InternalWriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextBytePut: byte + | b | + b := byte < 0 ifTrue: [byte bitAnd: 16rFF] ifFalse: [byte]. + position = limit ifTrue: [self grow]. + position := position + 1. + size < position ifTrue: [size := position]. + ^contents byteAt: position put: b +! ! + +!InternalWriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextPut: token + | index | + index := position + 1. + index > limit ifTrue: [self grow]. + position := index. + size < position ifTrue: [size := position]. + ^contents at: index put: token +! ! + +!InternalWriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextPutAll: aCollection + | n stop extra | + n := aCollection size. + n = 0 ifTrue: [^aCollection]. + extra := n - (limit - position). + extra > 0 ifTrue: [self growAtLeast: extra]. + stop := position + n. + (contents class == String and: [aCollection isWideString]) + ifTrue: [ + self beWide. + contents + replaceBytesFrom: position * 2 + 1 + to: stop * 2 + with: aCollection + startingAt: 1] + ifFalse: [contents + replaceFrom: position + 1 + to: stop + with: aCollection + startingAt: 1]. + position := stop. + size < position ifTrue: [size := position]. + ^aCollection +! ! + +!InternalWriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextPutChar: aCharacter + (self isWide not andNot: [aCharacter isByteCharacter]) ifTrue: [self beWide]. + ^self nextPut: aCharacter +! ! + +!InternalWriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextPutString: aString + self isWide ifTrue: [^self nextPutAll: aString asWideString]. + aString isWideString ifTrue: [self beWide]. + ^self nextPutAll: aString +! ! + +!InternalWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aCollection + contents := aCollection. + position := size := 0. + limit := contents size +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +peek + ^self atEnd ifFalse: [contents at: position + 1] +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +peek: anInteger + | end | + end := position + anInteger min: limit. + ^contents copyFrom: position + 1 to: end +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +position + ^position +! ! + +!InternalWriteStream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +position: anInteger + (0 <= anInteger and: [anInteger <= limit]) + ifFalse: [^self + error: 'position ' , anInteger asString , ' is out of bounds']. + position := anInteger +! ! + +!InternalWriteStream methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +putBytesFrom: aByteArray from: start to: stop + | length end s e w | + aByteArray isNil ifTrue: [^nil]. + length := stop - start + 1. + contents isWideString + ifTrue: [ + w := contents characterSize. + end := length // w + position. + s := position * w + 1. + e := position * w + length] + ifFalse: [ + end := position + length. + s := position + 1. + e := end]. + limit < end ifTrue: [self grow: end - limit]. + contents replaceBytesFrom: s to: e with: aByteArray startingAt: start. + position := end. + size < position ifTrue: [size := position] +! ! + +!InternalWriteStream methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +readStream + | reader | + reader := InternalReadStream on: contents. + reader + lineDelimiter: eol; + readLimit: (limit min: size). + ^reader +! ! + +!InternalWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reserve: amount + | extra | + amount <= limit ifTrue: [^self]. + extra := contents size - limit. + self grow: extra +! ! + +!InternalWriteStream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +reset + super reset. + size := 0 +! ! + +!InternalWriteStream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +setToEnd + position := size +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^size +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeToEnd + ^limit - position +! ! + +!InternalWriteStream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +skip: anInteger + | end | + end := position + anInteger. + limit < end ifTrue: [self grow: end - limit]. + position := position + anInteger max: 0 +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncate + self truncateTo: position +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncateTo: anInteger + size := anInteger +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +useCr + eol := String with: Cr +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +useCrLf + eol := String with: Cr with: Lf +! ! + +!InternalWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aCollection + self on: aCollection. + size := position := limit +! ! + +!InternalWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +writeLimit: anInteger + limit := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InternalWriteStream class' category: #Kernel! +InternalWriteStream class + instanceVariableNames: ''! + +!InternalWriteStream class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aCollection + ^self new with: aCollection +! ! + + +InternalWriteStream initialize! + diff --git a/modules/Kernel/Interval.Class.st b/modules/Kernel/Interval.Class.st new file mode 100644 index 00000000..a55402f1 --- /dev/null +++ b/modules/Kernel/Interval.Class.st @@ -0,0 +1,138 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Interval category: #Kernel! +ArrayedCollection subclass: #Interval + instanceVariableNames: 'start end step' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Interval commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Interval methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- delta + ^start - delta to: end - delta by: step +! ! + +!Interval methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ delta + ^start + delta to: end + delta by: step +! ! + +!Interval methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asStretch + ^start thru: end +! ! + +!Interval methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger + | answer | + anInteger > 0 ifTrue: [ + answer := start + (anInteger - 1 * step). + (step > 0 and: [answer between: start and: end]) ifTrue: [^answer]. + (step < 0 and: [answer between: end and: start]) ifTrue: [^answer]. + anInteger = self size ifTrue: [^end]]. + ^self outOfBoundsIndex: anInteger +! ! + +!Interval methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: aNumber + ^self shouldNotImplement +! ! + +!Interval methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: anInteger + | answer | + answer := start + (anInteger - 1 * step). + (step > 0 and: [answer between: start and: end]) ifTrue: [^answer]. + (step < 0 and: [answer between: end and: start]) ifTrue: [^answer]. + ^end +! ! + +!Interval methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +end + ^end +! ! + +!Interval methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +from: startInteger to: endInteger step: stepInteger + start := startInteger. + end := endInteger. + step := stepInteger. + step = 0 ifTrue: [^self error: 'zero size steps not allowed'] +! ! + +!Interval methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +intersection: aCollection + | s e | + aCollection class == self class ifFalse: [^super intersection: aCollection]. + step = aCollection step ifFalse: [^super intersection: aCollection]. + self isEmpty ifTrue: [^#()]. + aCollection isEmpty ifTrue: [^#()]. + s := start max: aCollection first. + e := end min: aCollection last. + ^s <= e ifTrue: [s to: e by: step] ifFalse: [^#()] +! ! + +!Interval methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream + nextPut: $(; + nextPutAll: start storeString; + nextPutAll: ' to: '; + nextPutAll: end storeString. + step = 1 + ifFalse: [aStream nextPutAll: ' by: '; nextPutAll: step storeString]. + aStream nextPut: $) +! ! + +!Interval methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +reversed + ^self class from: end to: start by: step negated +! ! + +!Interval methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + | size x | + size := 0 max: end - start // step + 1. + x := step * size + start. + ((step < 0 and: [end <= x]) or: [step > 0 and: [x <= end]]) + ifTrue: [size := size + 1]. + ^size +! ! + +!Interval methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +species + ^Array +! ! + +!Interval methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +start + ^start +! ! + +!Interval methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +step + ^step +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Interval class' category: #Kernel! +Interval class + instanceVariableNames: ''! + +!Interval class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +from: beginningInteger to: endInteger + ^self from: beginningInteger to: endInteger by: 1 +! ! + +!Interval class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +from: beginningInteger to: endInteger by: incrementInteger + ^self basicNew from: beginningInteger to: endInteger step: incrementInteger +! ! + + diff --git a/modules/Kernel/KernelModule.Class.st b/modules/Kernel/KernelModule.Class.st new file mode 100644 index 00000000..a6d8ac1c --- /dev/null +++ b/modules/Kernel/KernelModule.Class.st @@ -0,0 +1,302 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #KernelModule category: #Kernel! +Module subclass: #KernelModule + instanceVariableNames: 'memory entrypoint loadedModules moduleLoaders host CRITICAL unhandledErrorHandler session properties utf8 utf16 utf32' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!KernelModule commentStamp: '' prior: 0! + + Copyright (c) 2022, Quorum Software. + Copyright (c) 2020, LabWare. + See (MIT) license in root directory. +! + +!KernelModule methodsFor: 'snapshotting' stamp: 'KenD 28/Jun/2026 13:27:38'! +prepareForSnapshot: aBuilder + | dict loaders | + dict := Dictionary new. + dict at: #Kernel put: self. + loaders := OrderedCollection new. + loaders add: moduleLoaders first. + aBuilder + addNilToken; + map: loadedModules to: dict; + map: moduleLoaders to: loaders +! ! + +!KernelModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:38'! +bootstrap + | shift | + CompiledBlock initializeFormatFlags. + CompiledMethod initializeFormatFlags. + Species initializeFormatFlags. + Character initializeCharacters; initializeNamedCharacters; initializeLatin1Tables. + Closure initializeIndexes. + Float initializeConstants. + HashTable initializeConstants; initializeSizes. + HashTablePolicy initializeEmptySlot. + HashedCollection initializePolicies. + LargeInteger initializeBase. + LargeNegativeInteger initializeConstants. + SmallInteger initializeConstants. + cachedLookups := Dictionary new. + shift := WordSize = 8 ifTrue: [3] ifFalse: [2]. + namespace + at: #nil put: nil; + at: #true put: true; + at: #false put: false; + at: #WordSize put: WordSize; + at: #WordSizeShift put: shift; + at: #Kernel put: self; + at: #KnownSymbols put: #(+ - < > <= >= = == not); + at: #Processor put: ProcessorScheduler new. + StarToken initializeCurrent. + utf8 := UTF8 new. + utf16 := UTF16 new. + utf32 := UTF32 new. + Symbol initializeSymbolTable. + namespace at: #SymbolTable put: Symbol symbolTable. + Stream initializePools. + CharacterArray initializePools. + ProtoObject initializeConstants; initializeBitMasks. + + #FFICall. "hack to have this symbol (used by primitiveFFICall) in kernel ims" + self initialize. + CRITICAL := false. + self suspendOnUnhandledExceptions +! ! + +!KernelModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +addModuleLoader: aModuleLoader + moduleLoaders add: aModuleLoader +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +critical: aBlock + "critical meaning is: run without GC and without interrupts. On unhandled errors, don't + try to halt this process and continue with others, just freeze this OS process or exit." + prev := CRITICAL. + CRITICAL := true. + result := aBlock value. + CRITICAL := prev. + aBlock value +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +ensurePropertyTableFor: anObject + ^properties at: anObject ifAbsentPut: [IdentityDictionary new] +! ! + +!KernelModule methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026 13:27:38'! +ephemeronsDo: aBlock + session ephemeronsDo: aBlock. + properties ephemeronsDo: aBlock +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +exit + host exit: 0 +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +finalizer + ^session finalizer +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +freezeOnUnhandledExceptions + unhandledErrorHandler := [:exception | self _halt] +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +host + ^host +! ! + +!KernelModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + " + We cannot use addClass: because it creates new symbol instances, which must be + avoided during bootstrap (else we would end with duplicated symbols) + " + self basicInitialize; freezeOnUnhandledExceptions. + host := HostSystem new. + moduleLoaders := OrderedCollection new. + loadedModules := Dictionary new. + loadedModules at: #Kernel put: self. + namespace + keys do: [:symbol | | obj | + obj := namespace at: symbol. + obj isClass ifTrue: [classes add: obj]. + exports add: symbol]. + session := SmalltalkSession new. + properties := WeakIdentityDictionary new. + +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +properties + ^properties +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +propertiesFor: anObject + ^properties at: anObject ifAbsent: nil +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +readFile: filename + ^host readFile: filename +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +writeFile: aFilename contents: aString + ^host writeFile: aFilename contents: aString +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +createDirectory: aString + ^host createDirectory: aString +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +pathExists: aString + ^host pathExists: aString +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +currentDirectory + ^host currentDirectory +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +getEnv: aString + ^host getEnv: aString +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +loadModuleFromPath: aString + ^host loadModuleFromPath: aString +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +load: aSymbol + | filename | + loadedModules at: aSymbol ifPresent: [:module | ^module]. + moduleLoaders do: [:loader | + (loader load: aSymbol) ifNotNil: [:module | + loadedModules at: aSymbol put: module. + ^module]]. + ^self error: 'module not found' +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +loadedModules + ^loadedModules +! ! + +!KernelModule methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +loadedModuleNamed: aSymbol + ^loadedModules at: aSymbol ifAbsent: [] +! ! + +!KernelModule methodsFor: 'logging' stamp: 'KenD 28/Jun/2026 13:27:38'! +log: aString + ^host log: aString level: 2 +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +memory + ^memory +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +prepareForExecution: aCompiledMethod + self errorVMSpecific +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +processor + ^Processor +! ! + +!KernelModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +rehashWeakRegistries + session rehashWeakRegistries. + properties rehash +! ! + +!KernelModule methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeKey: aSymbol from: aMethodDictionary ifAbsent: aBlock + | cm | + cm := aMethodDictionary at: aSymbol ifAbsent: [^aBlock value]. + ^aMethodDictionary basicRemoveKey: aSymbol asSymbol ifAbsent: aBlock +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +suspendOnUnhandledExceptions + unhandledErrorHandler := [:exception | self suspendBecause: exception] +! ! + +!KernelModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +suspendBecause: anException + | active process | + active := Processor activeProcess. + process := Process sending: #suspended:because: to: host with: {active. anException}. + process takeControl +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +terminateOnUnhandledExceptions + unhandledErrorHandler := [:exception | self terminateSessionBecause: exception description] +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +terminateSessionBecause: aString + host logError: aString; logError: Processor activeProcess backtrace; exit: -1 +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +unhandledException: anException + | debuggable | + CRITICAL ifTrue: [self _error: 'process failed in a critical moment']. + unhandledErrorHandler value: anException +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +unhandledExceptionHandler: aClosure + unhandledErrorHandler := aClosure +! ! + +!KernelModule methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:38'! +useHostModuleLoader + host setupDefaultSearchPaths. + self addModuleLoader: host. +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf8 + ^utf8 +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf16 + ^utf16 +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf32 + ^utf32 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'KernelModule class' category: #Kernel! +KernelModule class + instanceVariableNames: ''! + + +KernelModule initialize! + diff --git a/modules/Kernel/KeyNotFound.Class.st b/modules/Kernel/KeyNotFound.Class.st new file mode 100644 index 00000000..e2499783 --- /dev/null +++ b/modules/Kernel/KeyNotFound.Class.st @@ -0,0 +1,38 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #KeyNotFound category: #Kernel! +Error subclass: #KeyNotFound + instanceVariableNames: 'object' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!KeyNotFound commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!KeyNotFound methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultDescription + | string | + string := [object printString] on: Error do: [:ex | ex description]. + ^'Key ' , string , ' is missing' +! ! + +!KeyNotFound methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +object: anObject + object := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'KeyNotFound class' category: #Kernel! +KeyNotFound class + instanceVariableNames: ''! + +!KeyNotFound class methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalFor: anObject + ^self new object: anObject; signal +! ! + + diff --git a/modules/Kernel/LMR/LMRArrayedCollection.Class.st b/modules/Kernel/LMR/LMRArrayedCollection.Class.st new file mode 100644 index 00000000..bc6543fc --- /dev/null +++ b/modules/Kernel/LMR/LMRArrayedCollection.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LMRArrayedCollection category: #Kernel! +ArrayedCollection subclass: #LMRArrayedCollection + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LMRArrayedCollection commentStamp: '' prior: 0! + + Copyright (c) 2023, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRArrayedCollection methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self primitiveSize +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRArrayedCollection class' category: #Kernel! +LMRArrayedCollection class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/LMR/LMRCharacterArray.Class.st b/modules/Kernel/LMR/LMRCharacterArray.Class.st new file mode 100644 index 00000000..11b951d4 --- /dev/null +++ b/modules/Kernel/LMR/LMRCharacterArray.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LMRCharacterArray category: #Kernel! +CharacterArray subclass: #LMRCharacterArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LMRCharacterArray commentStamp: '' prior: 0! + + Copyright (c) 2023, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRCharacterArray methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveSize + ^self _size +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRCharacterArray class' category: #Kernel! +LMRCharacterArray class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/LMR/LMRClosure.Class.st b/modules/Kernel/LMR/LMRClosure.Class.st new file mode 100644 index 00000000..ac943f78 --- /dev/null +++ b/modules/Kernel/LMR/LMRClosure.Class.st @@ -0,0 +1,88 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LMRClosure category: #Kernel! +Closure subclass: #LMRClosure + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LMRClosure commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRClosure methodsFor: '*handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateAtomically + | enabled | + enabled := Processor enableInterrupts: false. + ^self ensure: [Processor enableInterrupts: enabled] +! ! + +!LMRClosure methodsFor: '*handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWith: value + block argumentCount = 1 ifFalse: [^self arityError: 1]. + self _transferControlTo: block blockNativeCode +! ! + +!LMRClosure methodsFor: '*handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWith: anObject with: anotherObject + block argumentCount = 2 + ifFalse: [^super evaluateWith: anObject with: anotherObject]. + self _transferControlTo: block blockNativeCode +! ! + +!LMRClosure methodsFor: '*handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +value + block argumentCount = 0 ifFalse: [^self arityError: 0]. + self _transferControlTo: block blockNativeCode +! ! + +!LMRClosure methodsFor: '*handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: first + block argumentCount = 1 ifFalse: [^self arityError: 1]. + self _transferControlTo: block blockNativeCode +! ! + +!LMRClosure methodsFor: '*handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: first value: second + block argumentCount = 2 ifFalse: [^self arityError: 2]. + self _transferControlTo: block blockNativeCode +! ! + +!LMRClosure methodsFor: '*handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: first value: second value: third + block argumentCount = 3 ifFalse: [^self arityError: 3]. + self _transferControlTo: block blockNativeCode +! ! + +!LMRClosure methodsFor: '*handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueWithArguments: arguments + | size | + size := arguments basicSize. + block argumentCount = size ifFalse: [^self arityError: size]. + arguments _expandInStackSized: size. + ^self _invoke: block blockNativeCode +! ! + +!LMRClosure methodsFor: '*handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +whileFalse: aBlock + self value ifTrue: [^nil]. + aBlock value. + self _restart +! ! + +!LMRClosure methodsFor: '*handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +whileTrue: aBlock + self value ifFalse: [^nil]. + aBlock value. + self _restart +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRClosure class' category: #Kernel! +LMRClosure class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/LMR/LMRFloat.Class.st b/modules/Kernel/LMR/LMRFloat.Class.st new file mode 100644 index 00000000..d3d6ea70 --- /dev/null +++ b/modules/Kernel/LMR/LMRFloat.Class.st @@ -0,0 +1,195 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LMRFloat category: #Kernel! +Float subclass: #LMRFloat + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LMRFloat commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aNumber + | new result | + aNumber isFloat ifFalse: [^self - aNumber asFloat]. + new := Float new. + result := self _floatMinus: aNumber into: new. + result == new ifTrue: [^result]. + ^self errorOn: #'-' status: result +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +* aNumber + | new result | + aNumber isFloat ifFalse: [^self * aNumber asFloat]. + new := Float new. + result := self _floatMultiply: aNumber into: new. + result == new ifTrue: [^result]. + ^self errorOn: #'*' status: result +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +/ aNumber + | new result | + aNumber isFloat ifFalse: [^self / aNumber asFloat]. + new := Float new. + result := self _floatQuotient: aNumber into: new. + result == new ifTrue: [^result]. + ^self errorOn: #'/' status: result +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aNumber + | new result | + aNumber isFloat ifFalse: [^aNumber addTo: self]. + new := Float new. + result := self _floatPlus: aNumber into: new. + result == new ifTrue: [^result]. + ^self errorOn: #'+' status: result +! ! + +!LMRFloat methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aNumber + | result | + aNumber isFloat ifFalse: [^self < aNumber asFloat]. + result := self _floatLessThan: aNumber. + result _isSmallInteger ifFalse: [^result]. + ^self errorOn: #'<' status: result +! ! + +!LMRFloat methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aNumber + | result nan equal | + aNumber isFloat + ifFalse: [^aNumber isNumber + ifTrue: [self = aNumber asFloat] + ifFalse: [false]]. + result := self _floatEquals: aNumber. + result _isSmallInteger ifFalse: [^result]. + nan := self isNaN. + equal := nan == aNumber isNaN. + equal ifFalse: [^false]. + nan ifTrue: [^true]. + ^self errorOn: #'=' status: result +! ! + +!LMRFloat methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + ^self basicByteAt: index +! ! + +!LMRFloat methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: index + ^self basicByteAt: index +! ! + +!LMRFloat methodsFor: 'random' stamp: 'KenD 28/Jun/2026 13:27:38'! +fractionPart + | new result | + new := Float new. + result := self _floatFractionPartInto: new. + result == new ifTrue: [^result]. + ^self errorOn: #fractionPart status: result +! ! + +!Float methodsFor: 'random' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeWith: bytes + bytes _primitiveULargeAtOffset: 0 into: self +! ! + +!LMRFloat methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +significand + | result new | + new := Float new. + result := self _floatSignificandInto: new. + result == new ifTrue: [^result]. + ^self errorOn: #significand status: result +! ! + +!LMRFloat methodsFor: 'functions' stamp: 'KenD 28/Jun/2026 13:27:38'! +sqrt + | sqrt result | + sqrt := Float new. + result := self _floatSqrtInto: sqrt. + "_floatSqrtInto returns error status in result if any, else the result itself" + result == sqrt ifTrue: [^result]. + ^self errorOn: #sqrt status: result +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +timesTwoPower: anInteger + | result status | + result := self copy. + status := result _timesTwoPower: anInteger asFloat. + (Float hasErrorFlag: status) ifFalse: [^result]. + self errorOn: #timesTwoPower status: status +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncated + | result | + result := self _floatTruncated. + (result notNil and: [result = 0 or: [result sign = self sign]]) + ifTrue: [^result]. + self isSpecialValue ifTrue: [^self]. + ^self abs < 2.0e16 + ifTrue: [| q r | + q := self quo: 536870912.0. + "((SmallInteger largestPositive bitShift: -1) + 1) asFloat" + r := self - (q asFloat * 536870912.0). + q * 536870912 + r truncated] + ifFalse: [self asTrueFraction] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRFloat class' category: #Kernel! +LMRFloat class + instanceVariableNames: ''! + +!LMRFloat class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromInteger: anInteger + | result | + result := Float new. + anInteger _isSmallInteger ifTrue: [ + anInteger _asFloatInto: result. + ^result]. + anInteger isInteger + ifTrue: [^(self fromInteger: (anInteger bitShift: -24)) * 16r1000000 asFloat + + (self fromInteger: (anInteger bitAnd: 16rFFFFFF))] + ifFalse: [self error: 'number is not an integer'] +! ! + +!LMRFloat class methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialControlAndStatusFlags + " + FIXME: ONLY X64 SUPPORTED FOR NOW + We initialize MXCSR with all sticky bits clean (0-5), all exceptions masked (7-12), + and denormal arguments of operations treated as zero (bit 6). + We don't flush denormal results to zero (bit 15), but should think about it. + " + ^0x1FC0 +! ! + +!LMRFloat class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeStatus + " + this has to be done fairly early at startup, before + doing any float operation, because float operations + try to use this value, which must be already initialized + to what the OS put in MXCSR (or equivalent) register + " + Status isNil ifTrue: [Status := ByteArray new: 4]. + Status uLongAtOffset: 0 put: self status +! ! + +!LMRFloat class methodsFor: '*instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self memory newArrayedBytes: instanceBehavior size: 8. +! ! + + diff --git a/modules/Kernel/LMR/LMRModule.Class.st b/modules/Kernel/LMR/LMRModule.Class.st new file mode 100644 index 00000000..117f9568 --- /dev/null +++ b/modules/Kernel/LMR/LMRModule.Class.st @@ -0,0 +1,28 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LMRModule category: #Kernel! +Module subclass: #LMRModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LMRModule commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +imports + ^{ + #Kernel -> #(ArrayedCollection CharacterArray Closure Float ProtoObject Species Symbol) + } +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRModule class' category: #Kernel! +LMRModule class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/LMR/LMRObject.Class.st b/modules/Kernel/LMR/LMRObject.Class.st new file mode 100644 index 00000000..69b1ee9c --- /dev/null +++ b/modules/Kernel/LMR/LMRObject.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LMRObject category: #Kernel! +Object subclass: #LMRObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LMRObject commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self primitiveSize +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRObject class' category: #Kernel! +LMRObject class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/LMR/LMRProtoObject.Class.st b/modules/Kernel/LMR/LMRProtoObject.Class.st new file mode 100644 index 00000000..450f0e87 --- /dev/null +++ b/modules/Kernel/LMR/LMRProtoObject.Class.st @@ -0,0 +1,457 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LMRProtoObject category: #Kernel! +ProtoObject subclass: #LMRProtoObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LMRProtoObject commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRProtoObject methodsFor: '*system' stamp: 'KenD 28/Jun/2026 13:27:38'! +== anObject + ^self _identityEquals: anObject +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beArrayed + self _flagsSet: IsArrayed +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beBytes + self _flagsSet: IsBytes +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beFirstGeneration + self _flagsMask: IsSecondGenerationMask +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beLarge + self _flagsMask: IsSmallMask +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beNamed + self _flagsSet: IsNamed +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beNotRemembered + self _flagsMask: IsRememberedMask +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beNotSpecial + self _flagsMask: IsSpecialMask +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beRemembered + self _flagsSet: IsRemembered +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beSecondGeneration + self _flagsSet: IsSecondGeneration +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beSeen + self _flagsSet: HasBeenSeen +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beSmall + self _flagsSet: IsSmall +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beSpecial + self _flagsSet: IsSpecial +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beUnseen + self _flagsMask: HasBeenSeenMask +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_cachedLookup: aSymbol + ^self _cachedLookup: aSymbol in: self behavior +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_cachedLookup: aSymbol in: behavior + ^GlobalDispatchCache current lookupAndCache: aSymbol in: behavior +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_copyBasicHeaderFrom: other + self + _basicULongAt: -1 put: (other _basicULongAt: -1); + _basicULongAt: 0 put: (other _basicULongAt: 0) +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_copyHeaderSized: byteSize from: anObject + byteSize = 16 ifTrue: [ + self + _basicULongAt: -3 put: (anObject _basicULongAt: -3); + _basicULongAt: -2 put: (anObject _basicULongAt: -2)]. + self + _basicULongAt: -1 put: (anObject _basicULongAt: -1); + _basicULongAt: 0 put: (anObject _basicULongAt: 0) +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_flagsMask: mask + self _basicFlags: (self _basicFlags bitAnd: mask) +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_flagsSet: mask + self _basicFlags: (self _basicFlags bitOr: mask) +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_hasBeenSeen + ^(self _basicFlags bitAnd: HasBeenSeen) == HasBeenSeen +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_hasNamedSlots + ^(self _basicFlags bitAnd: IsNamed) = IsNamed +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_headerSizeInBytes + ^self _isSmall ifTrue: [8] ifFalse: [16] +! ! + +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_highHalf + ^self _oop bitShift: WordSize * 8 // -2 +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_invoke: aNativeCode + " + senders of _invoke: MUST have at least 1 temporary. The argument of + _invoke: is removed twice: once here and once again after returning from + _invoke. If no temps are present, the second pop smashes the compiled + method of the frame, which happens to be in the top of the stack. This + would only be noticed by random crashes when executing debuggable + methods (because they send a message after _invoke: and before returning) + " + ^self _transferControlDiscardingLastArgTo: aNativeCode +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isArrayed + ^false == self _isFixed +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isBytes + ^(self _basicFlags bitAnd: IsBytes) = IsBytes +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isFixed + ^(self _basicFlags bitAnd: IsArrayed) == 0 +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isLarge + ^(self _basicFlags bitAnd: IsSmall) == 0 +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isProxy + ^self _hasBeenSeen +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isRemembered + ^(self _basicFlags bitAnd: IsRemembered) = IsRemembered +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isSecondGeneration + ^(self _basicFlags bitAnd: IsSecondGeneration) = IsSecondGeneration +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isSmall + ^(self _basicFlags bitAnd: IsSmall) = IsSmall +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isSpecial + ^(self _basicFlags bitAnd: IsSpecial) = IsSpecial +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_largeSize: size + self _basicULongAt: _ExtendedSize put: size _asNative +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_lookup: aSymbol + ^self _lookup: aSymbol in: self behavior +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_lookup: aSymbol in: behavior + | methods cm next | + methods := behavior _basicAt: 2. + cm := self _lookup: aSymbol inDictionary: methods. + cm == nil ifFalse: [^cm]. + next := behavior _basicAt: 3. + ^next == nil ifFalse: [self _lookup: aSymbol in: next] +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_lookup: aSymbol inDictionary: methodDictionary + | table | + table := methodDictionary _basicAt: 2. + 2 + to: table _size + by: 2 + do: [:j | (table _basicAt: j) == aSymbol ifTrue: [^table _basicAt: j + 1]]. + ^nil +! ! + +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_low32 + ^WordSize > 4 ifTrue: [self bitAnd: 0xFFFFFFFF] ifFalse: [self] +! ! + +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_lowHalf + ^self _oop bitAnd: 16rFFFF +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_makeExtendedSize: size + self + _beLarge; + _smallSize: 4; + _largeSize: size; + _basicULongAt: _Reserved put: 0 _asNative +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_nextBasePointer + ^self _asPointer + self _sizeInBytes _asPointer +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_objectFromBasePointer + | offset | + offset := (self _asObject _byteAt: 4) > 127 ifTrue: [8] ifFalse: [16]. + ^(self + offset _asPointer) _asObject +! ! + +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_oop + ^self _asPointer * 2 +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_pointersSize + ^self _isBytes ifTrue: [0] ifFalse: [self _size] +! ! + +!LMRProtoObject methodsFor: 'raw access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_uLongAtValidOffset: offset put: anInteger + anInteger size > 4 ifTrue: [self error: 'does not fit in 32 bits']. + self _primitiveULongAtOffset: offset put: anInteger. + ^anInteger +! ! + +!LMRProtoObject methodsFor: 'unwinding' stamp: 'KenD 28/Jun/2026 13:27:38'! +_returnTo: aBeeFrame + [#forceEnvironment]. + aBeeFrame _beCurrent. + ^self +! ! + +!LMRProtoObject methodsFor: '*header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_size + ^self _isSmall ifTrue: [self _smallSize] ifFalse: [self _largeSize] +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_sizeInBytes + | total | + total := self _size. + ^self _isBytes + ifTrue: [total + WordSize - 1 bitAnd: 0 - WordSize] + ifFalse: [total * WordSize] +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_strongPointersSize + ^(self _isBytes or: [self _isSpecial]) ifTrue: [0] ifFalse: [0 + self _size] +! ! + +!LMRProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +allReferences + ^Memory current collectAndCompactOldSpace; referencesTo: self +! ! + +!LMRProtoObject methodsFor: '*system' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicHash + | hash shifted | + " + LastHash := 1. + LFSR implementation (avoids 0 by definition) + " + hash := self _basicHash. + hash == 0 ifFalse: [^hash]. + shifted := LastHash bitShift: -1. + hash := (LastHash bitAnd: 1) = 0 + ifTrue: [shifted] + ifFalse: [shifted bitXor: 16rB9C8]. + self _basicHash: hash. + ^LastHash := hash +! ! + +!LMRProtoObject methodsFor: '*system' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicHash: anInteger + self _basicHash: anInteger +! ! + +!LMRProtoObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +become: anotherObject + Memory current make: self become: anotherObject +! ! + +!LMRProtoObject methodsFor: '*meta accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +behavior + ^self _isSmallInteger + ifTrue: [SmallInteger instanceBehavior] + ifFalse: [self _basicULongAt: 0] +! ! + +!LMRProtoObject methodsFor: '*meta accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +behavior: aBehavior + ^self _isSmallInteger + ifTrue: [self error: 'can''t change behavior of a small integer'] + ifFalse: [ + aBehavior _holdRefererIfNeeded: self. + self _basicULongAt: 0 put: aBehavior] +! ! + +!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +doesNotUnderstandSelector: selector + | arguments message | + arguments := StackFrameCursor top moveNext + argumentsWithArity: selector arity. + message := Message receiver: self selector: selector arguments: arguments. + ^self doesNotUnderstand: message +! ! + +!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +holdRefererIfNeeded: referent + | memory | + #savePreviousSelf. + self _isSmallInteger ifTrue: [^self]. + referent _isRemembered ifTrue: [^self]. + memory := Memory current. + (memory isYoungSafe: referent) + ifFalse: [(memory isYoungSafe: self) ifTrue: [memory remember: referent]] +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeExtended: aBoolean contentSize: size + self _basicULongAt: -1 put: 0 _asNative. + aBoolean + ifTrue: [ + self + _smallSize: 4; + _basicULongAt: _ExtendedSize put: size _asNative; + _basicULongAt: _Reserved put: 0 _asNative] + ifFalse: [self _smallSize: size; _beSmall] +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookupAndInvoke: aSymbol + | cm | + cm := self _cachedLookup: aSymbol. + cm == nil ifTrue: [^self doesNotUnderstandSelector: aSymbol]. + cm prepareForExecution. + self _transferControlDiscardingLastArgTo: cm validNativeCodeAddress _asNative +! ! + +!LMRProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +perform: aSymbol withArguments: anArray + | size | + size := anArray basicSize. + aSymbol arity = size ifFalse: [^self error: 'incorrect arity']. + anArray _expandInStackSized: size. + ^self lookupAndInvoke: aSymbol +! ! + +!LMRProtoObject methodsFor: '*accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveAt: i + self _isSmallInteger ifTrue: [^self shouldNotImplement]. + ^self _isBytes + ifTrue: [self basicByteAt: i] + ifFalse: [self basicObjectAt: i] +! ! + +!LMRProtoObject methodsFor: '*accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveAt: i put: anObject + self _isSmallInteger ifTrue: [^self shouldNotImplement]. + ^self _isBytes + ifTrue: [self basicByteAt: i put: anObject] + ifFalse: [self basicObjectAt: i put: anObject] +! ! + +!LMRProtoObject methodsFor: '*system' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveSize + | size | + self _isSmallInteger ifTrue: [^0]. + self _isArrayed ifFalse: [^0]. + size := self _size. + ^self _hasNamedSlots ifTrue: [size - self class instSize] ifFalse: [size] +! ! + +!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +shouldBeInRememberedSet + | m | + m := Memory current. + (m isYoung: self) ifTrue: [^false]. + (m isYoung: self behavior) ifTrue: [^true]. + 1 to: self _pointersSize do: [:index | | ivar | + ivar := self _basicAt: index. + ivar _isSmallInteger ifFalse: [(m isYoung: ivar) ifTrue: [^true]]]. + ^false +! ! + +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +smallOop + ^self _asPointer +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRProtoObject class' category: #Kernel! +LMRProtoObject class + instanceVariableNames: ''! + +!ProtoObject class methodsFor: '*system' stamp: 'KenD 28/Jun/2026 13:27:38'! +undermethodSelectors + ^LMRProtoObject methodDictionary values asArray select: [:m | m selector beginsWith: '_'] +! ! + + diff --git a/modules/Kernel/LMR/LMRSmallInteger.Class.st b/modules/Kernel/LMR/LMRSmallInteger.Class.st new file mode 100644 index 00000000..97061b1e --- /dev/null +++ b/modules/Kernel/LMR/LMRSmallInteger.Class.st @@ -0,0 +1,112 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LMRSmallInteger category: #Kernel! +SmallInteger subclass: #LMRSmallInteger + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LMRSmallInteger commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRSmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aNumber + aNumber _isSmallInteger ifFalse: [^(aNumber - self) negated]. + ^(self _smiMinus: aNumber) ifNil: [self asLargeInteger - aNumber] +! ! + +!LMRSmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!!= aNumber + aNumber _isSmallInteger ifFalse: [^aNumber !!= self]. + ^(self == aNumber) not +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +* aNumber + aNumber _isSmallInteger ifFalse: [^aNumber * self]. + (self _smiTimes: aNumber) ifNotNil: [:res | ^res]. + + size := self sizeInBytes + aNumber sizeInBytes. + result := self positive = aNumber positive + ifTrue: [LargePositiveInteger new: size] + ifFalse: [LargeNegativeInteger new: size]. + ^(self _smiTimes: aNumber into: result) reduced +! ! + +!LMRSmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +// aNumber + aNumber == 0 ifTrue: [^self zeroDivisorOn: #'//']. + aNumber _isSmallInteger + ifTrue: [ + result := self _quotientTowardZero: aNumber. + ^(self >= 0 = (aNumber >= 0) or: [result * aNumber = self]) + ifTrue: [result] + ifFalse: [result - 1]] + ifFalse: [ + aNumber isInteger + ifTrue: [^self = 0 | (self positive = aNumber positive) + ifTrue: [0] + ifFalse: [-1]]. + quotient := self / aNumber. + answer := quotient truncated. + ^(quotient < 0 and: [quotient !!= answer]) + ifTrue: [answer - 1] + ifFalse: [answer]] +! ! + +!LMRSmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +\\ aNumber + aNumber == 0 ifTrue: [^self zeroDivisorOn: #'\\']. + aNumber _isSmallInteger + ifTrue: [^self _remainderTowardZero: aNumber] + ifFalse: [ + aNumber isLargeInteger + ifTrue: [aNumber positive == self positive ifTrue: [^self]]. + ^super \\ aNumber] +! ! + +!LMRSmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aNumber + ^aNumber _isSmallInteger + ifTrue: [self asLargeInteger + aNumber] + ifFalse: [aNumber + self] +! ! + +!LMRSmallInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aNumber + ^aNumber _isSmallInteger + ifTrue: [self _smiEquals: aNumber] + ifFalse: [aNumber = self] +! ! + +!LMRSmallInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aNumber + ^aNumber _isSmallInteger + ifTrue: [self _smiGreaterThan: aNumber] + ifFalse: [aNumber < self] +! ! + +!LMRSmallInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aNumber + ^aNumber _isSmallInteger + ifTrue: [self _smiGreaterEqualThan: aNumber] + ifFalse: [aNumber <= self] +! ! + +!LMRSmallInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^self = 0 + ifTrue: [1] + ifFalse: [WordSize - (self _leadingZeroBitCount _bitShiftRight: 3)] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRSmallInteger class' category: #Kernel! +LMRSmallInteger class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/LMR/LMRSpecies.Class.st b/modules/Kernel/LMR/LMRSpecies.Class.st new file mode 100644 index 00000000..82187b53 --- /dev/null +++ b/modules/Kernel/LMR/LMRSpecies.Class.st @@ -0,0 +1,100 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LMRSpecies category: #Kernel! +ProtoObject subclass: #LMRSpecies + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LMRSpecies commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +allocate: byteSize size: size + | headerSize totalSize buffer object extended | + extended := size > 255. + headerSize := extended ifTrue: [16] ifFalse: [8]. + totalSize := headerSize + byteSize. + buffer := self memory allocate: totalSize. + object := (buffer + headerSize _asPointer) _asObject. + object + _basicULongAt: _Behavior put: self instanceBehavior; + initializeExtended: extended contentSize: size. + ^object +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew + ^self _instancesAreArrayed + ifTrue: [self primitiveNew: 0] + ifFalse: [self primitiveNew]! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew: anInteger + ^self primitiveNew: anInteger +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +memory + ^Memory current +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self _instancesAreArrayed + ifTrue: [self primitiveNew: 0] + ifFalse: [self primitiveNew] +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self primitiveNew: anInteger +! ! + +!LMRSpecies methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +nil: size slotsOf: object + object _nilSlots: size +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNew + ^self memory newPointers: instanceBehavior size: self instSize +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNew: size + size _isSmallInteger ifFalse: [self error: 'invalid size']. + self _instancesAreArrayed ifFalse: [self errorNotIndexable]. + ^self _instancesHavePointers + ifTrue: [self primitiveNewPointers: size + self instSize] + ifFalse: [self primitiveNewBytes: size] +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNewBytes: size + ^self memory newArrayedBytes: instanceBehavior size: size +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNewPointers: size + ^self memory + newArrayedPointers: instanceBehavior + size: size + named: self instSize > 0 +! ! + +!LMRSpecies methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +zero: size bytesOf: object + object _zeroSlots: (size bitShift: 0 - WordSizeShift) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRSpecies class' category: #Kernel! +LMRSpecies class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/LMR/LMRSymbol.Class.st b/modules/Kernel/LMR/LMRSymbol.Class.st new file mode 100644 index 00000000..891f6f16 --- /dev/null +++ b/modules/Kernel/LMR/LMRSymbol.Class.st @@ -0,0 +1,27 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LMRSymbol category: #Kernel! +Symbol subclass: #LMRSymbol + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LMRSymbol commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +flushCacheFor: species + GlobalDispatchCache current flush: self forSpecies: species. + SendSite flush: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRSymbol class' category: #Kernel! +LMRSymbol class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/LargeInteger.Class.st b/modules/Kernel/LargeInteger.Class.st new file mode 100644 index 00000000..2d26ab8e --- /dev/null +++ b/modules/Kernel/LargeInteger.Class.st @@ -0,0 +1,540 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LargeInteger category: #Kernel! +Integer subclass: #LargeInteger + instanceVariableNames: '' + classVariableNames: 'Base Bits DigitLength' + poolDictionaries: '' + category: 'Kernel'! +!LargeInteger commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!LargeInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aNumber + ^self + aNumber negated +! ! + +!LargeInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +& anInteger + ^self bitAnd: anInteger +! ! + +!LargeInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +* aNumber + | product | + aNumber isInteger ifFalse: [^aNumber * self]. + aNumber = 0 ifTrue: [^0]. + product := self abs mult: aNumber abs. + ^self positive == aNumber positive + ifTrue: [product] + ifFalse: [product negated] +! ! + +!LargeInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +/ aNumber + aNumber isInteger ifFalse: [^(aNumber / self) reciprocal]. + ^super / aNumber +! ! + +!LargeInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +// aNumber + | data | + aNumber isZero ifTrue: [^self zeroDivisorOn: #'//']. + aNumber isFraction ifTrue: [^self * aNumber reciprocal // 1]. + aNumber isFloat ifTrue: [^self asFloat // aNumber]. + aNumber isInteger ifFalse: [ + ^self + error: 'cannot divide ' , self printString , ' by ' , aNumber printString]. + data := self quoRem: aNumber. + ^data at: 1 +! ! + +!LargeInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +\\ aNumber + | data | + aNumber isZero ifTrue: [^self zeroDivisorOn: #'\\']. + aNumber isFraction ifTrue: [^super \\ aNumber]. + aNumber isFloat ifTrue: [^self asFloat \\ aNumber]. + aNumber isInteger ifFalse: [ + ^self + error: 'cannot divide ' , self printString , ' by ' , aNumber printString]. + data := self quoRem: aNumber. + ^data at: 2 +! ! + +!LargeInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +| anInteger + ^self bitOr: anInteger +! ! + +!LargeInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aNumber + aNumber isInteger ifFalse: [^aNumber + self]. + aNumber = 0 ifTrue: [^self]. + ^self addDigits: aNumber +! ! + +!LargeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! ++= anInteger + | carry | + carry := 0. + 1 to: self nbDigits do: [:index | | digit | + digit := anInteger wideDigitAt: index. + carry := self adc: digit + carry at: index] +! ! + +!LargeInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aNumber + | n m | + aNumber isInteger ifFalse: [^aNumber > self]. + self negative = aNumber negative ifFalse: [^self negative]. + aNumber isSmallInteger ifTrue: [^self negative]. + n := self sizeInBytes. + m := aNumber sizeInBytes. + n > m ifTrue: [^self negative]. + n < m ifTrue: [^self positive]. + n // DigitLength to: 1 by: -1 do: [:i | | d e | + d := self wideDigitAt: i. + e := aNumber wideDigitAt: i. + d !!= e ifTrue: [^d < e]]. + ^false +! ! + +!LargeInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aNumber + | n m | + aNumber isInteger ifFalse: [^aNumber >= self]. + self negative = aNumber negative ifFalse: [^self negative]. + aNumber isSmallInteger ifTrue: [^self negative]. + n := self sizeInBytes. + m := aNumber sizeInBytes. + n > m ifTrue: [^self negative]. + n < m ifTrue: [^self positive]. + n // DigitLength to: 1 by: -1 do: [:i | | d e | + d := self wideDigitAt: i. + e := aNumber wideDigitAt: i. + d = e ifFalse: [^d < e]]. + ^true +! ! + +!LargeInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aNumber + | n | + aNumber isInteger ifFalse: [^aNumber = self]. + aNumber isSmallInteger ifTrue: [^false]. + self positive == aNumber positive ifFalse: [^false]. + n := self nbDigits. + n = (aNumber sizeInBytes + DigitLength - 1 // DigitLength) ifFalse: [^false]. + 1 + to: n + do: [:i | (self wideDigitAt: i) = (aNumber wideDigitAt: i) ifFalse: [^false]]. + ^true +! ! + +!LargeInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aNumber + ^(self <= aNumber) not +! ! + +!LargeInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aNumber + ^(self < aNumber) not +! ! + +!LargeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +adc: integer at: index + | s carry | + s := (self wideDigitAt: index) + integer. + carry := s >= Base ifTrue: [1] ifFalse: [0]. + self digitAt: index put: (s bitAnd: Base - 1). + ^carry +! ! + +!LargeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anInteger fromDigit: index + | integer i shift | + integer := anInteger. + i := index. + shift := Bits negated. + [integer > 0] whileTrue: [| digit | + digit := self wideDigitAt: i. + integer := integer + digit. + self digitAt: i put: integer. + integer := integer bitShift: shift. + i := i + 1] +! ! + +!LargeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +addDigits: anInteger + | n integer | + n := self sizeInBytes max: anInteger sizeInBytes. + (self positive == anInteger positive + or: [self positive and: [self highWideDigit highBit = Bits]] + or: [anInteger highWideDigit highBit = Bits]) + ifTrue: [n := n + DigitLength]. + integer := self copyOfSize: n. + integer += anInteger. + ((self negative or: [anInteger negative]) + and: [integer highWideDigit highBit = Bits]) + ifTrue: [integer changeClassTo: LargeNegativeInteger]. + ^integer reduced +! ! + +!LargeInteger methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asLargeInteger + ^self +! ! + +!LargeInteger methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asParameter + self ASSERT: self sizeInBytes = WordSize. + ^self +! ! + +!LargeInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitAnd: anInteger + | n m class s integer | + anInteger isInteger ifFalse: [^anInteger bitAnd: self]. + anInteger = 0 ifTrue: [^0]. + n := self sizeInBytes. + m := anInteger sizeInBytes. + (self negative and: [anInteger negative]) + ifTrue: [ + class := LargeNegativeInteger. + s := n max: m] + ifFalse: [ + class := LargePositiveInteger. + self positive + ifTrue: [anInteger negative ifTrue: [s := n] ifFalse: [s := n min: m]] + ifFalse: [s := m]]. + integer := class new: s. + 1 to: integer nbDigits do: [:i | | d e | + d := self wideDigitAt: i. + e := anInteger wideDigitAt: i. + integer digitAt: i put: (d bitAnd: e)]. + ^integer reduced +! ! + +!LargeInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitAt: anInteger + | i digit | + i := anInteger - 1 // Bits + 1. + digit := self wideDigitAt: i. + i > self nbDigits ifTrue: [^digit bitAnd: 1]. + ^digit bitAt: anInteger - 1 \\ Bits + 1 +! ! + +!LargeInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitOr: anInteger + | n m class s integer | + anInteger isInteger ifFalse: [^anInteger bitOr: self]. + anInteger = -1 ifTrue: [^-1]. + n := self sizeInBytes. + m := anInteger sizeInBytes. + (self positive and: [anInteger positive]) + ifTrue: [ + class := LargePositiveInteger. + s := n max: m] + ifFalse: [ + class := LargeNegativeInteger. + self negative + ifTrue: [anInteger positive ifTrue: [s := n] ifFalse: [s := n min: m]] + ifFalse: [s := m]. + s := s + DigitLength]. + integer := class new: s. + 1 to: integer nbDigits do: [:i | | d e | + d := self wideDigitAt: i. + e := anInteger wideDigitAt: i. + integer digitAt: i put: (d bitOr: e)]. + ^integer reduced +! ! + +!LargeInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitShift: delta + | count bits m result q carry i | + delta = 0 ifTrue: [^self]. + bits := self nbDigits * Bits + delta. + bits <= 0 ifTrue: [^0]. + result := self class + new: bits + 3 // 4 + (Bits / 4) - 1 // (Bits / 4) * DigitLength. + m := result nbDigits. + count := delta abs. + q := count // Bits. + delta >= 0 ifTrue: [ + carry := 0. + i := m. + [i > q] whileTrue: [| d | + d := self wideDigitAt: i - q. + result digitAt: i put: d. + i := i - 1]. + self negative ifTrue: [ + [i > 0] whileTrue: [ + result digitAt: i put: 0. + i := i - 1]]. + count := count \\ Bits. + count > 0 ifTrue: [ + 1 to: m do: [:j | | d sigma s | + d := result wideDigitAt: j. + sigma := d bitShift: count. + s := (sigma bitAnd: Base - 1) bitOr: carry. + result digitAt: j put: s. + carry := d bitShift: count - Bits]]. + ^result reduced]. + 1 to: m do: [:j | | d | + d := self wideDigitAt: j + q. + result digitAt: j put: d]. + count := count \\ Bits. + count > 0 ifTrue: [ + count := count negated. + carry := self negative + ifTrue: [(-1 bitShift: Bits + count) bitAnd: Base - 1] + ifFalse: [0]. + i := m. + [i >= 1] whileTrue: [| sigma s | + sigma := result wideDigitAt: i. + s := (sigma bitShift: count) bitOr: carry. + result digitAt: i put: s. + carry := (sigma bitShift: Bits + count) bitAnd: Base - 1. + i := i - 1]]. + result := result reduced. + (self negative and: [result = 0]) ifTrue: [^-1]. + ^result +! ! + +!LargeInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitXor: anInteger + | n class integer | + anInteger isInteger ifFalse: [^anInteger bitXor: self]. + n := self sizeInBytes max: anInteger sizeInBytes. + class := self positive = anInteger positive + ifTrue: [LargePositiveInteger] + ifFalse: [LargeNegativeInteger]. + integer := class new: n. + 1 to: integer nbDigits do: [:i | | d e | + d := self wideDigitAt: i. + e := anInteger wideDigitAt: i. + integer digitAt: i put: (d bitXor: e)]. + ^integer reduced +! ! + +!LargeInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: i + ^self at: i +! ! + +!LargeInteger methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + | copy | + copy := self class new: self size. + ^copy from: self +! ! + +!LargeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +digitAt: index put: integer + | valid | + valid := integer bitAnd: Base - 1. + self uShortAtOffset: index - 1 * DigitLength put: valid +! ! + +!LargeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +digits + ^(1 to: self nbDigits) collect: [:i | (self wideDigitAt: i) hex] +! ! + +!LargeInteger methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +from: aLargeInteger + | n | + n := self sizeInBytes min: aLargeInteger sizeInBytes. + self replaceFrom: 1 to: n with: aLargeInteger startingAt: 1 +! ! + +!LargeInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + | hash | + hash := self sizeInBytes. + 1 + to: hash + do: [:i | hash := (hash hashMultiply: 16r19660D) bitXor: (self at: i)]. + ^hash +! ! + +!LargeInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +highWideDigit + ^self wideDigitAt: self nbDigits +! ! + +!LargeInteger methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isLargeInteger + ^true +! ! + +!LargeInteger methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isOnBit: bits + 1 to: bits sizeInBytes + DigitLength - 1 // DigitLength do: [:i | | digit n | + digit := self wideDigitAt: i. + n := bits wideDigitAt: i. + (digit bitAnd: n) = n ifFalse: [^false]]. + ^true +! ! + +!LargeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nbDigits + ^self sizeInBytes // DigitLength +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +outOfBoundsIndex: anInteger + ^self + error: 'index: ' , anInteger printString + , ' is outside of large integer bounds' +! ! + +!LargeInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +negated + ^self bitInvert + 1 +! ! + +!LargeInteger methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop with: aCollection startingAt: position + ^self + replaceBytesFrom: start + to: stop + with: aCollection + startingAt: position +! ! + +!LargeInteger methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +shortAtOffset: offset + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 2 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self shortAtValidOffset: offset +! ! + +!LargeInteger methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +shortAtValidOffset: offset + | lo hi sign | + lo := self byteAtValid: offset + 1. + hi := self byteAtValid: offset + 2. + sign := hi bitAnd: 16r80. + hi := hi - (sign * 2). + ^hi * 16r100 + lo +! ! + +!LargeInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^self size +! ! + +!LargeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +uShortAtOffset: offset + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 1 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uShortAtValidOffset: offset +! ! + +!LargeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +uShortAtOffset: offset put: anInteger + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 1 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uShortAtValidOffset: offset put: anInteger +! ! + +!LargeInteger methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +uShortAtValidOffset: offset + ^(self byteAtValid: offset + 2) * 16r100 + (self byteAtValid: offset + 1) +! ! + +!LargeInteger methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +uShortAtValidOffset: offset put: anInteger + anInteger size > 2 ifTrue: [self error: 'does not fit in 16 bits']. + self _uShortAtOffset: offset put: anInteger. + ^anInteger +! ! + +!LargeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +wideDigitAt: index + | offset | + index <= 0 ifTrue: [self error: 'non positive index']. + offset := index - 1 * DigitLength. + ^offset + 2 <= self sizeInBytes ifTrue: [self uShortAtOffset: offset] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LargeInteger class' category: #Kernel! +LargeInteger class + instanceVariableNames: 'Base Bits DigitLength'! + +!LargeInteger class methodsFor: 'inspecting' stamp: 'KenD 28/Jun/2026 13:27:38'! +aspects + ^super aspects copyWith: #digits +! ! + +!LargeInteger class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +base + ^Base +! ! + +!LargeInteger class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +digitBits + ^Bits +! ! + +!LargeInteger class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromInteger: anInteger + | int integer size n large i | + int := anInteger asInteger. + integer := int abs. + size := 0. + n := self nbDigitsFor: integer. + i := n. + [i >= 1 and: [size = 0]] whileTrue: [| digit | + digit := integer wideDigitAt: i. + digit > 0 ifTrue: [size := i] ifFalse: [i := i - 1]]. + large := LargePositiveInteger new: size * DigitLength. + 1 to: size do: [:j | | digit | + digit := integer wideDigitAt: j. + large digitAt: j put: digit]. + ^int >= 0 ifTrue: [large] ifFalse: [large negated] +! ! + +!LargeInteger class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromInteger: anInteger byteShiftLeft: shift + | size bytes result start | + size := anInteger sizeInBytes. + bytes := size + shift. + result := anInteger >= 0 + ifTrue: [LargePositiveInteger new: bytes] + ifFalse: [LargeNegativeInteger new: bytes]. + start := bytes - size. + 1 to: size do: [:i | result at: start + i put: (anInteger at: i)]. + ^result +! ! + +!LargeInteger class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeBase + Bits := 16. + Base := 2 raisedToInteger: Bits. + DigitLength := Bits + 7 // 8 +! ! + +!LargeInteger class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nbDigitsFor: anInteger + " + LargeInteger2 nbDigitsFor: 16r88234567 + " + ^anInteger sizeInBytes + DigitLength - 1 // DigitLength +! ! + +!LargeInteger class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self basicNew: anInteger + DigitLength - 1 // DigitLength * DigitLength +! ! + + diff --git a/modules/Kernel/LargeNegativeInteger.Class.st b/modules/Kernel/LargeNegativeInteger.Class.st new file mode 100644 index 00000000..74242841 --- /dev/null +++ b/modules/Kernel/LargeNegativeInteger.Class.st @@ -0,0 +1,190 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LargeNegativeInteger category: #Kernel! +LargeInteger subclass: #LargeNegativeInteger + instanceVariableNames: '' + classVariableNames: 'LeftLimit' + poolDictionaries: '' + category: 'Kernel'! +!LargeNegativeInteger commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!LargeNegativeInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +abs + ^self negated +! ! + +!LargeNegativeInteger methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asFloat + ^self negated asFloat negated +! ! + +!LargeNegativeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + (index _isSmallInteger and: [index >= 1]) + ifFalse: [^self outOfBoundsIndex: index]. + index > self _size ifTrue: [^16rFF]. + ^self byteAtValid: index +! ! + +!LargeNegativeInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitInvert + | mask integer | + mask := Base - 1. + integer := LargePositiveInteger new: self sizeInBytes. + 1 to: self nbDigits do: [:i | | digit | + digit := self wideDigitAt: i. + integer digitAt: i put: (digit bitXor: mask)]. + ^integer reduced +! ! + +!LargeNegativeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyOfSize: n + | copy | + copy := LargePositiveInteger new: n. + self nbDigits + 1 to: copy nbDigits do: [:i | copy digitAt: i put: -1]. + copy from: self. + ^copy +! ! + +!LargeNegativeInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + -16r20000000000000 <= self ifTrue: [^self asFloat hash]. + ^super hash +! ! + +!LargeNegativeInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +highBit + " + Taken from Squeak + " + ^self error: 'not valid for negative numbers' +! ! + +!LargeNegativeInteger methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +negative + ^true +! ! + +!LargeNegativeInteger methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +positive + ^false +! ! + +!LargeNegativeInteger methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPut: $-. + self negated printOn: aStream +! ! + +!LargeNegativeInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +quo: divisor + | data quo rem | + divisor isFloat ifTrue: [^self asFloat quo: divisor]. + divisor isFraction ifTrue: [^(divisor reciprocal * self) truncated]. + divisor isInteger ifFalse: [^self error: 'cannot divide']. + divisor = 0 ifTrue: [^self zeroDivisorOn: #quo]. + data := self quoRem: divisor. + quo := data at: 1. + divisor negative ifTrue: [^quo]. + rem := data at: 2. + ^rem = 0 ifTrue: [quo] ifFalse: [quo + 1] +! ! + +!LargeNegativeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +quoRem: divisor + | data quo rem s | + divisor positive + ifTrue: [ + s := divisor + self. + s > 0 ifTrue: [^{-1. s}]] + ifFalse: [self > divisor ifTrue: [^{0. self}]]. + data := self abs computeQuoRem: divisor abs. + quo := data at: 1. + rem := data at: 2. + rem = 0 ifTrue: [ + divisor positive ifTrue: [data at: 1 put: quo negated]. + ^data]. + divisor positive ifTrue: [ + ^data + at: 1 put: (quo + 1) negated; + at: 2 put: divisor - rem; + yourself]. + ^data at: 2 put: rem negated; yourself +! ! + +!LargeNegativeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reduced + | n mask | + self = LeftLimit ifTrue: [^SmallInteger minimum]. + n := self nbDigits. + mask := Base - 1. + [ + n > 1 + and: [(self wideDigitAt: n) = mask] + and: [(self wideDigitAt: n - 1) highBit = Bits]] + whileTrue: [n := n - 1]. + ^self reducedTo: n +! ! + +!LargeNegativeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reducedTo: n + | hi sign result integer | + hi := self wideDigitAt: n. + (n > 4 or: [n = 4 and: [hi < 0xC000]]) ifTrue: [ + integer := self class new: n * DigitLength. + ^integer replaceFrom: 1 to: n * DigitLength with: self startingAt: 1]. + sign := hi bitAnd: 0x8000. + result := hi - (sign * 2). + n = 1 ifTrue: [^result]. + result := (result _bitShiftLeft: Bits) + (self wideDigitAt: n - 1). + n = 2 ifTrue: [^result]. + result := (result _bitShiftLeft: Bits) + (self wideDigitAt: n - 2). + n = 3 ifTrue: [^result]. + ^(result _bitShiftLeft: Bits) + (self wideDigitAt: n - 3) +! ! + +!LargeNegativeInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sign + ^-1 +! ! + +!LargeNegativeInteger methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +strictlyPositive + ^false +! ! + +!LargeNegativeInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +wideDigitAt: index + ^(super wideDigitAt: index) ifNil: [Base - 1] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LargeNegativeInteger class' category: #Kernel! +LargeNegativeInteger class + instanceVariableNames: 'LeftLimit'! + +!LargeNegativeInteger class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeConstants + LeftLimit := self basicNew: WordSize. + LeftLimit at: WordSize put: 16rC0 +! ! + +!LargeNegativeInteger class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftLimit + ^LeftLimit +! ! + +!LargeNegativeInteger class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + | large | + large := super new: anInteger. + 1 to: large nbDigits do: [:i | large digitAt: i put: Base - 1]. + ^large +! ! + + diff --git a/modules/Kernel/LargePositiveInteger.Class.st b/modules/Kernel/LargePositiveInteger.Class.st new file mode 100644 index 00000000..6a37b64c --- /dev/null +++ b/modules/Kernel/LargePositiveInteger.Class.st @@ -0,0 +1,320 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LargePositiveInteger category: #Kernel! +LargeInteger subclass: #LargePositiveInteger + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LargePositiveInteger commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!LargePositiveInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +abs + ^self +! ! + +!LargePositiveInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + (index _isSmallInteger and: [index >= 1]) + ifFalse: [^self outOfBoundsIndex: index]. + index > self _size ifTrue: [^0]. + ^self byteAtValid: index +! ! + +!LargePositiveInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitAnd: anInteger + (anInteger isSmallInteger and: [anInteger > 0]) + ifTrue: [^anInteger bitAnd: self]. + ^super bitAnd: anInteger +! ! + +!LargePositiveInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitInvert + | n integer mask | + n := self highWideDigit highBit = Bits + ifTrue: [self sizeInBytes + DigitLength] + ifFalse: [self sizeInBytes]. + integer := LargeNegativeInteger new: n. + mask := Base - 1. + 1 to: self nbDigits do: [:i | | digit | + digit := self wideDigitAt: i. + integer digitAt: i put: (digit bitXor: mask)]. + ^integer +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +computeQuoRem: divisor + | u v n m shift quo qhat a0 b a2 j k t aux qr | + self sizeInBytes < divisor sizeInBytes ifTrue: [^{0. self}]. + divisor < Base ifTrue: [^self fastQuoRem: divisor]. + shift := Bits - divisor highWideDigit highBit. + u := self bitShift: shift. + v := divisor bitShift: shift. + n := v sizeInBytes + DigitLength - 1 // DigitLength * DigitLength. + m := u sizeInBytes - n + DigitLength. + quo := self class new: m. + b := v highWideDigit. + j := m // DigitLength. + n := n // DigitLength. + aux := self class new: DigitLength * 2. + qr := Array new: 2. + [j >= 1] whileTrue: [| a1 rhat | + k := j + n. + a0 := u wideDigitAt: k. + a0 = b ifTrue: [qhat := Base - 1] ifFalse: [ + a1 := u wideDigitAt: k - 1. + t := a0 < 16r4000 ifTrue: [(a0 bitShift: Bits) + a1] ifFalse: [ + aux + digitAt: 1 put: a1; + digitAt: 2 put: a0]. + t isSmallInteger + ifTrue: [ + qhat := t // b. + rhat := t - (qhat * b)] + ifFalse: [ + t twoDigitsQuoRem: b on: qr. + qhat := qr at: 1. + rhat := qr at: 2]. + a2 := u wideDigitAt: k - 2. + qhat > 0 ifTrue: [ + [| s s2 | + s := qhat * (v wideDigitAt: n - 1). + s2 := s wideDigitAt: 2. + s2 > rhat or: [rhat = s2 and: [(s wideDigitAt: 1) > a2]]] + whileTrue: [ + qhat := qhat - 1. + rhat := rhat + b]]]. + t := u - (v * (qhat bitShift: j - 1 * Bits)). + t negative + ifTrue: [ + u := u - (v * (qhat - 1 bitShift: j - 1 * Bits)). + quo digitAt: j put: qhat - 1] + ifFalse: [ + u := t. + quo digitAt: j put: qhat]. + u = 0 ifTrue: [^{quo reduced. 0}]. + j := j - 1]. + u := u bitShift: shift negated. + ^{quo reduced. u reduced} +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyOfSize: n + | copy | + copy := LargePositiveInteger new: n. + copy from: self. + ^copy +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +fastQuoRem: divisor + | quo u j qr aux | + quo := self class new: self sizeInBytes. + u := 0. + j := self nbDigits. + qr := Array new: 2. + aux := self class new: DigitLength * 2. + [j >= 1] whileTrue: [| b qhat a1 | + a1 := self wideDigitAt: j. + b := u < 16r4000 ifTrue: [(u bitShift: Bits) + a1] ifFalse: [ + aux + digitAt: 1 put: a1; + digitAt: 2 put: u]. + b isSmallInteger + ifTrue: [ + qhat := b // divisor. + u := b \\ divisor] + ifFalse: [ + b twoDigitsQuoRem: divisor on: qr. + qhat := qr at: 1. + u := qr at: 2]. + quo digitAt: j put: qhat. + j := j - 1]. + self negative ifTrue: [u := u negated]. + ^{quo reduced. u} +! ! + +!LargePositiveInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + self <= 16r20000000000000 ifTrue: [^self asFloat hash]. + ^super hash +! ! + +!LargePositiveInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +highBit + " + Taken from Squeak + " + | n last | + n := self nbDigits. + [(last := self wideDigitAt: n) = 0] + whileTrue: [(n := n - 1) = 0 ifTrue: [^0]]. + ^last highBit + (Bits * (n - 1)) +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +mult: aNumber + | m integer n result | + m := self nbDigits. + integer := aNumber. + n := self class nbDigitsFor: integer. + result := LargePositiveInteger new: n + m * DigitLength. + 0 to: m - 1 do: [:i | | digit | + digit := self wideDigitAt: i + 1. + 1 to: n do: [:j | | d | + d := integer wideDigitAt: j. + result add: digit * d fromDigit: i + j]]. + ^result reduced +! ! + +!LargePositiveInteger methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +negative + ^false +! ! + +!LargePositiveInteger methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +positive + ^true +! ! + +!LargePositiveInteger methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + | digits index quotient | + digits := OrderedCollection new. + index := 1. + quotient := self. + [quotient isSmallInteger] whileFalse: [| data | + data := quotient quoRem: 100. + digits add: (data at: 2). + quotient := data at: 1. + index := index + 1]. + quotient printOn: aStream. + index - 1 to: 1 by: -1 do: [:i | + aStream nextPut: (Character value: (digits at: i) // 10 + 48). + aStream nextPut: (Character value: (digits at: i) \\ 10 + 48)] +! ! + +!LargePositiveInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +quo: divisor + | data quo rem | + divisor isFloat ifTrue: [^self asFloat quo: divisor]. + divisor isFraction ifTrue: [^(divisor reciprocal * self) truncated]. + divisor isInteger ifFalse: [^self error: 'cannot divide']. + divisor = 0 ifTrue: [^self zeroDivisorOn: #quo]. + data := self quoRem: divisor. + quo := data at: 1. + rem := data at: 2. + ^rem negative ifTrue: [quo + 1] ifFalse: [quo] +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +quoRem: divisor + | data quo rem s | + divisor positive ifTrue: [self < divisor ifTrue: [^{0. self}]] ifFalse: [ + s := self + divisor. + s < 0 ifTrue: [^{-1. s}]]. + data := self computeQuoRem: divisor abs. + divisor positive ifTrue: [^data]. + quo := data at: 1. + rem := data at: 2. + rem = 0 ifTrue: [^data at: 1 put: quo negated; yourself]. + ^data + at: 1 put: (quo + 1) negated; + at: 2 put: rem + divisor; + yourself +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reduced + | n result integer | + n := self nbDigits. + result := (self wideDigitAt: n) !!= 0 ifTrue: [self] ifFalse: [ + [ + n > 1 and: [ + n := n - 1. + (self wideDigitAt: n) = 0]] whileTrue. + self reducedTo: n]. + result isSmallInteger ifTrue: [^result]. + (result size > WordSize or: [(result at: WordSize) > 63]) ifTrue: [^result]. + integer := 0. + 1 + to: result size // DigitLength + do: [:i | integer := ((result wideDigitAt: i) bitShift: i - 1 * Bits) + + integer]. + ^integer +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reducedTo: n + | hi result integer | + hi := self wideDigitAt: n. + (n > 4 or: [n = 4 and: [hi >= 0x4000]]) ifTrue: [ + integer := self class new: n * DigitLength. + ^integer replaceFrom: 1 to: n * DigitLength with: self startingAt: 1]. + n = 1 ifTrue: [^hi]. + result := (hi _bitShiftLeft: Bits) + (self wideDigitAt: n - 1). + n = 2 ifTrue: [^result]. + result := (result _bitShiftLeft: Bits) + (self wideDigitAt: n - 2). + n = 3 ifTrue: [^result]. + ^(result _bitShiftLeft: Bits) + (self wideDigitAt: n - 3) +! ! + +!LargePositiveInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sign + ^1 +! ! + +!LargePositiveInteger methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +strictlyPositive + ^true +! ! + +!LargePositiveInteger methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +timesRepeat: aBlock + | max n | + max := SmallInteger maximum. + n := self // max. + [n > 0] whileTrue: [ + max timesRepeat: aBlock. + n := n - 1]. + self \\ max timesRepeat: aBlock +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +twoDigitDivisionBits + true ifTrue: [^2]. + ^Bits - (WordSize * 4) + (WordSize * 8 - SmallInteger maximum highBit // 2) * 2 +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +twoDigitsQuoRem: d on: array + | k a d1 s c q1 b rem | + k := self twoDigitDivisionBits. + a := self wideDigitAt: 2. + d1 := d bitShift: k negated. + s := d bitAnd: (1 bitShift: k) - 1. + c := a bitShift: Bits - k. + q1 := c // d1. + b := self wideDigitAt: 1. + rem := (c \\ d1 bitShift: k) - (s * q1) + b. + array + at: 1 put: rem // d + q1; + at: 2 put: rem \\ d +! ! + +!LargePositiveInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +wideDigitAt: index + ^(super wideDigitAt: index) ifNil: 0 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LargePositiveInteger class' category: #Kernel! +LargePositiveInteger class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/LaunchContext.Class.st b/modules/Kernel/LaunchContext.Class.st new file mode 100644 index 00000000..3839d143 --- /dev/null +++ b/modules/Kernel/LaunchContext.Class.st @@ -0,0 +1,52 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LaunchContext category: #Kernel! +Context subclass: #LaunchContext + instanceVariableNames: 'arguments' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LaunchContext commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!LaunchContext methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +arguments + ^arguments +! ! + +!LaunchContext methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +arguments: anArray + arguments := anArray +! ! + +!LaunchContext methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyAllTo: aProcessStack + | index base | + index := aProcessStack bufferSize. + arguments do: [:arg | + aProcessStack at: index put: arg. + index := index - 1]. + + base := index - 1. + aProcessStack + pcAt: index put: 0 of: nil; + bpAt: base put: 0. + + ^self copyTo: aProcessStack at: index - 2 +! ! + +!LaunchContext methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +previousEnvironment + ^nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LaunchContext class' category: #Kernel! +LaunchContext class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/LinkedCollection.Class.st b/modules/Kernel/LinkedCollection.Class.st new file mode 100644 index 00000000..451caba4 --- /dev/null +++ b/modules/Kernel/LinkedCollection.Class.st @@ -0,0 +1,120 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #LinkedCollection category: #Kernel! +SequenceableCollection subclass: #LinkedCollection + instanceVariableNames: 'next localSize' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!LinkedCollection commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!LinkedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject + ^next == nil + ifTrue: [ + localSize = self basicSize + ifTrue: [ + self createNextLink. + next add: anObject] + ifFalse: [self basicAdd: anObject]] + ifFalse: [next add: anObject] +! ! + +!LinkedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger + (0 < anInteger and: [anInteger <= self basicSize]) + ifTrue: [^self basicAt: anInteger]. + next == nil + ifTrue: [self outOfBoundsIndex: anInteger] + ifFalse: [^next at: anInteger - localSize] +! ! + +!LinkedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: anObject + (0 < anInteger and: [anInteger <= localSize]) + ifTrue: [^self basicAt: anInteger put: anObject]. + next == nil + ifTrue: [self outOfBoundsIndex: anInteger] + ifFalse: [^next at: anInteger - localSize put: anObject] +! ! + +!LinkedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAdd: anObject + localSize := localSize + 1. + self basicAt: localSize put: anObject +! ! + +!LinkedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyFrom: beginning to: end + | total copy | + total := end - beginning + 1. + total negative ifTrue: [self outOfBoundsIndex: total]. + copy := self species new: total. + copy localSize: total. + ^copy replaceFrom: 1 to: total with: self startingAt: beginning +! ! + +!LinkedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +createNextLink + next := self species new: self basicSize * 2 +! ! + +!LinkedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + | index | + index := 0. + [ + index := index + 1. + index <= localSize] + whileTrue: [aBlock evaluateWith: (self basicAt: index)]. + next == nil ifFalse: [next do: aBlock] +! ! + +!LinkedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasIndexedSlots + ^true +! ! + +!LinkedCollection methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + localSize := 0 +! ! + +!LinkedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +localSize: anInteger + localSize := anInteger +! ! + +!LinkedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + | extra | + extra := next == nil ifTrue: [0] ifFalse: [next size]. + ^localSize + extra +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LinkedCollection class' category: #Kernel! +LinkedCollection class + instanceVariableNames: ''! + +!LinkedCollection class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self new: 50 +! ! + +!LinkedCollection class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + | instance | + instance := super new: anInteger. + instance initialize. + ^instance +! ! + + +LinkedCollection initialize! + diff --git a/modules/Kernel/Locale.Class.st b/modules/Kernel/Locale.Class.st new file mode 100644 index 00000000..b87c3ac5 --- /dev/null +++ b/modules/Kernel/Locale.Class.st @@ -0,0 +1,199 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Locale category: #Kernel! +Object subclass: #Locale + instanceVariableNames: 'currency date number time' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Locale commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Locale methodsFor: 'times' stamp: 'KenD 28/Jun/2026 13:27:38'! +amSymbol + ^time amSymbol +! ! + +!Locale methodsFor: 'currency' stamp: 'KenD 28/Jun/2026 13:27:38'! +currency + ^currency currency +! ! + +!Locale methodsFor: 'currency' stamp: 'KenD 28/Jun/2026 13:27:38'! +currencyDigits + ^currency decimalPlaces +! ! + +!Locale methodsFor: 'currency' stamp: 'KenD 28/Jun/2026 13:27:38'! +currencyFormat + ^currency positiveFormat +! ! + +!Locale methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:38'! +dataSeparator + ^self listSeparator +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +dateFormat + ^date shortFormat +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +dateFrom: aString + | stream | + stream := aString isString ifTrue: [aString readStream] ifFalse: [aString]. + ^date dateFromStream: stream +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +dateSeparator + ^date separator +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +dayNames + ^date dayNames +! ! + +!Locale methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:38'! +decimalPlaces + ^number decimalPlaces +! ! + +!Locale methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:38'! +decimalSeparator + ^self decimalSymbol +! ! + +!Locale methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:38'! +decimalSymbol + ^number decimalSymbol +! ! + +!Locale methodsFor: 'currency' stamp: 'KenD 28/Jun/2026 13:27:38'! +formatCurrency: aString + ^currency format: aString +! ! + +!Locale methodsFor: 'currency' stamp: 'KenD 28/Jun/2026 13:27:38'! +formatNegativeCurrency: aString + ^currency formatNegative: aString +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfMonth: aString + ^date indexOfMonth: aString +! ! + +!Locale methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + "Pending.... + currency := Smalltalk os currencyFormat default. + date := Smalltalk os dateFormat default. + number := Smalltalk os numberFormat default. + time := Smalltalk os timeFormat default" +! ! + +!Locale methodsFor: 'times' stamp: 'KenD 28/Jun/2026 13:27:38'! +isTimeFormat12Hour + ^time is12hr +! ! + +!Locale methodsFor: 'language' stamp: 'KenD 28/Jun/2026 13:27:38'! +language + ^date language +! ! + +!Locale methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:38'! +listSeparator + ^number listSeparator +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +longDateFormat + ^date longFormat +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +monthNames + ^date monthNames +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +nameOfDay: anInteger + ^date nameOfDay: anInteger +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +nameOfMonth: anInteger + ^date nameOfMonth: anInteger +! ! + +!Locale methodsFor: 'currency' stamp: 'KenD 28/Jun/2026 13:27:38'! +negativeCurrencyFormat + ^currency negativeFormat +! ! + +!Locale methodsFor: 'times' stamp: 'KenD 28/Jun/2026 13:27:38'! +pmSymbol + ^time pmSymbol +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +printShortDate: aDate on: aStream + date printShort: aDate on: aStream +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +shortDateFormat + ^date shortFormat +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +shortDayNames + ^date shortDayNames +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +shortMonthNames + ^date shortMonthNames +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +shortNameOfDay: anInteger + ^date shortNameOfDay: anInteger +! ! + +!Locale methodsFor: 'dates' stamp: 'KenD 28/Jun/2026 13:27:38'! +shortNameOfMonth: anInteger + ^date shortNameOfMonth: anInteger +! ! + +!Locale methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:38'! +thousandsSeparator + ^number groupingSymbol +! ! + +!Locale methodsFor: 'times' stamp: 'KenD 28/Jun/2026 13:27:38'! +timeSeparator + ^time separator +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Locale class' category: #Kernel! +Locale class + instanceVariableNames: ''! + +!Locale class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +startUp + self module namespace at: #ActiveLocale put: self new +! ! + + +Locale initialize! + diff --git a/modules/Kernel/Magnitude.Class.st b/modules/Kernel/Magnitude.Class.st new file mode 100644 index 00000000..3204f677 --- /dev/null +++ b/modules/Kernel/Magnitude.Class.st @@ -0,0 +1,71 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Magnitude category: #Kernel! +Object subclass: #Magnitude + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Magnitude commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Magnitude methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aMagnitude + self subclassResponsibility +! ! + +!Magnitude methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aMagnitude + self subclassResponsibility +! ! + +!Magnitude methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aMagnitude + self subclassResponsibility +! ! + +!Magnitude methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aMagnitude + ^aMagnitude < self +! ! + +!Magnitude methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aMagnitude + ^aMagnitude <= self +! ! + +!Magnitude methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +addTo: aMagnitude + ^aMagnitude + self asFloat +! ! + +!Magnitude methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +between: min and: max + ^min <= self and: [self <= max] +! ! + +!Magnitude methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^self subclassResponsibility +! ! + +!Magnitude methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +max: aMagnitude + ^self > aMagnitude ifTrue: [self] ifFalse: [aMagnitude] +! ! + +!Magnitude methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +min: aMagnitude + ^self < aMagnitude ifTrue: [self] ifFalse: [aMagnitude] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Magnitude class' category: #Kernel! +Magnitude class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/MatchAlgorithm.Class.st b/modules/Kernel/MatchAlgorithm.Class.st new file mode 100644 index 00000000..abd1eb05 --- /dev/null +++ b/modules/Kernel/MatchAlgorithm.Class.st @@ -0,0 +1,183 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #MatchAlgorithm category: #Kernel! +Object subclass: #MatchAlgorithm + instanceVariableNames: 'string pattern start stop tokens failure ranges' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!MatchAlgorithm commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!MatchAlgorithm methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +failBecause: aString + failure := aString +! ! + +!MatchAlgorithm methodsFor: 'outputs' stamp: 'KenD 28/Jun/2026 13:27:38'! +failure + ^failure +! ! + +!MatchAlgorithm methodsFor: 'outputs' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasMatched + ^failure isNil and: [tokens isEmpty] +! ! + +!MatchAlgorithm methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasTokens + ^failure isNil and: [tokens notEmpty] +! ! + +!MatchAlgorithm methodsFor: 'inputs' stamp: 'KenD 28/Jun/2026 13:27:38'! +index: anInteger + start := anInteger +! ! + +!MatchAlgorithm methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + start := 1 +! ! + +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchFirstStar + | range | + range := string start @ nil. + ranges add: tokens first -> range. + tokens removeFirst. + self hasTokens + ifTrue: [tokens first matchFirstAfterStartOn: self] + ifFalse: [ + range y: string stop. + string stop: string start - 1] +! ! + +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchFirstToken + | token min match save | + token := tokens first. + min := token length. + match := false. + save := string start. + [ + string length >= min and: [ + match := string beginsWith: token. + match not]] + whileTrue: [string start: string start + 1]. + match + ifTrue: [ + ranges add: token -> (string start @ (string start + min - 1)). + string start: string start + token length. + tokens removeFirst] + ifFalse: [ + tokens size = 1 ifTrue: [ + string start: save. + ^self privateMatchLastToken]. + self + failBecause: token asString , ' not present at position ' + , string start printString] +! ! + +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchFirstTokenAfterStar + | token i | + token := tokens first. + i := string indexOf: token. + i = 0 + ifTrue: [ + self + failBecause: token asString , ' not present in inteval [' + , string start printString + , ', ' + , string stop printString] + ifFalse: [ + ranges last value y: i - 1. + ranges add: token -> (i @ (i + token length - 1)). + string start: i + token length. + tokens removeFirst] +! ! + +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchLastToken + tokens size = 1 + ifTrue: [self matchFirstToken] + ifFalse: [self privateMatchLastToken] +! ! + +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchNextToken + tokens first matchFirstOn: self +! ! + +!MatchAlgorithm methodsFor: 'outputs' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchRange + | sorted | + sorted := ranges collect: #value thenSelect: [:p | p x <= p y]. + sorted := sorted asSortedCollection: [:p :q | p x < q x]. + ^sorted notEmpty ifTrue: [sorted first x @ sorted last y] +! ! + +!MatchAlgorithm methodsFor: 'inputs' stamp: 'KenD 28/Jun/2026 13:27:38'! +pattern: aStringPattern + pattern := aStringPattern +! ! + +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026 13:27:38'! +privateMatchLastToken + | token min match | + token := tokens last. + min := token length. + match := false. + [ + string length >= min and: [ + match := string endsWith: token. + match not]] + whileTrue: [string stop: string stop - 1]. + match + ifTrue: [ + ranges add: token -> (string stop - min + 1 @ string stop). + string stop: string stop - token length. + tokens removeLast] + ifFalse: [ + self + failBecause: token asString , ' not present at position ' + , (string stop - token length + 1) printString] +! ! + +!MatchAlgorithm methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reset + | end | + failure := nil. + tokens := pattern tokens. + string start: start. + end := stop notNil ifTrue: [stop] ifFalse: [string string size]. + string stop: end. + ranges := OrderedCollection new: tokens size +! ! + +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026 13:27:38'! +run + self reset. + tokens isEmpty ifTrue: [^self]. + tokens last matchLastOn: self. + [self hasTokens] whileTrue: [self matchNextToken] +! ! + +!MatchAlgorithm methodsFor: 'inputs' stamp: 'KenD 28/Jun/2026 13:27:38'! +string: aString + string := MatchToken on: aString from: 1 to: aString size +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MatchAlgorithm class' category: #Kernel! +MatchAlgorithm class + instanceVariableNames: ''! + + +MatchAlgorithm initialize! + diff --git a/modules/Kernel/MatchToken.Class.st b/modules/Kernel/MatchToken.Class.st new file mode 100644 index 00000000..f6d271c8 --- /dev/null +++ b/modules/Kernel/MatchToken.Class.st @@ -0,0 +1,119 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #MatchToken category: #Kernel! +Object subclass: #MatchToken + instanceVariableNames: 'string start stop' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!MatchToken commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!MatchToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asString + ^string copyFrom: start to: stop +! ! + +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: i + ^string at: i +! ! + +!MatchToken methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +beginsWith: aMatchToken + self length >= aMatchToken length ifFalse: [^false]. + aMatchToken start to: aMatchToken stop do: [:i | | char | + char := aMatchToken at: i. + ((self at: start + i - 1) = char or: [char isQuestionMark]) ifFalse: [^false]]. + ^true +! ! + +!MatchToken methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +endsWith: aMatchToken + | end | + self length >= aMatchToken length ifFalse: [^false]. + end := aMatchToken stop. + end to: aMatchToken start by: -1 do: [:i | | char | + char := aMatchToken at: i. + ((self at: stop - end + i) = char or: [char isQuestionMark]) ifFalse: [^false]]. + ^true +! ! + +!MatchToken methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: aMatchToken + ^string indexOfString: aMatchToken asString from: start to: stop +! ! + +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +length + ^stop - start + 1 +! ! + +!MatchToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchFirstAfterStartOn: aMatchAlgorithm + aMatchAlgorithm matchFirstTokenAfterStar +! ! + +!MatchToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchFirstOn: aMatchAlgorithm + aMatchAlgorithm matchFirstToken +! ! + +!MatchToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchLastOn: aMatchAlgorithm + aMatchAlgorithm matchLastToken +! ! + +!MatchToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + start to: stop do: [:i | aStream nextPut: (string at: i)] +! ! + +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +start + ^start +! ! + +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +start: anInteger + start := anInteger +! ! + +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +stop + ^stop +! ! + +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +stop: anInteger + stop := anInteger +! ! + +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +string + ^string +! ! + +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +string: aString + string := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MatchToken class' category: #Kernel! +MatchToken class + instanceVariableNames: ''! + +!MatchToken class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aString from: start to: stop + ^self new + string: aString; + start: start; + stop: stop +! ! + + diff --git a/modules/Kernel/Message.Class.st b/modules/Kernel/Message.Class.st new file mode 100644 index 00000000..41248142 --- /dev/null +++ b/modules/Kernel/Message.Class.st @@ -0,0 +1,142 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Message category: #Kernel! +Object subclass: #Message + instanceVariableNames: 'selector arguments' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Message commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Message methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aMessage + self == aMessage ifTrue: [^true]. + self class == aMessage class ifFalse: [^false]. + self selector == aMessage selector ifFalse: [^false]. + ^self arguments = aMessage arguments +! ! + +!Message methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +argumentAt: anInteger + ^arguments at: anInteger +! ! + +!Message methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +argumentAt: anInteger put: anObject + arguments at: anInteger put: anObject +! ! + +!Message methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +arguments + ^arguments +! ! + +!Message methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +arguments: anArray + arguments := anArray +! ! + +!Message methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +arity + ^selector isNil + ifTrue: [arguments size] + ifFalse: [selector arity] +! ! + +!Message methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +buildArguments: aCollection + | predefined args | + predefined := self arguments. + aCollection size = predefined size ifTrue: [^aCollection]. + args := predefined isNil + ifTrue: [Array new: selector arity] + ifFalse: [predefined copy]. + ^args + replaceFrom: 1 + to: (aCollection size min: args size) + with: aCollection + startingAt: 1 +! ! + +!Message methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^selector hashWith: arguments +! ! + +!Message methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMessage + ^true +! ! + +!Message methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +performOn: anObject + ^anObject perform: selector withArguments: arguments +! ! + +!Message methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream + nextPutAll: self class name; + nextPut: $(; + nextPutAll: selector printString; + nextPut: $) +! ! + +!Message methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver + ^nil +! ! + +!Message methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +selector + ^selector +! ! + +!Message methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +selector: aSymbol + selector := aSymbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Message class' category: #Kernel! +Message class + instanceVariableNames: ''! + +!Message class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject selector: aSymbol + | arguments | + arguments := Array new: aSymbol arity. + ^self receiver: anObject selector: aSymbol arguments: arguments +! ! + +!Message class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject selector: aSymbol argument: anotherObject + ^self receiver: anObject selector: aSymbol arguments: {anotherObject} +! ! + +!Message class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject selector: aSymbol arguments: anArray + ^MessageSend new receiver: anObject selector: aSymbol arguments: anArray +! ! + +!Message class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +selector: aSymbol + ^self selector: aSymbol arguments: #() +! ! + +!Message class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +selector: aSymbol argument: anObject + ^self selector: aSymbol arguments: {anObject} +! ! + +!Message class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +selector: aSymbol arguments: anArray + ^self new selector: aSymbol; arguments: anArray +! ! + + diff --git a/modules/Kernel/MessageNotUnderstood.Class.st b/modules/Kernel/MessageNotUnderstood.Class.st new file mode 100644 index 00000000..2643c7ce --- /dev/null +++ b/modules/Kernel/MessageNotUnderstood.Class.st @@ -0,0 +1,83 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #MessageNotUnderstood category: #Kernel! +Error subclass: #MessageNotUnderstood + instanceVariableNames: 'message receiver' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!MessageNotUnderstood commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!MessageNotUnderstood methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultAction + super defaultAction. + ^message performOn: receiver +! ! + +!MessageNotUnderstood methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultDescription + | selector | + message isNil ifTrue: [^super defaultDescription]. + selector := message selector ifNil: [^super defaultDescription]. + receiver isNil ifTrue: [^selector storeString , ' was sent to nil']. + ^selector storeString , ' not understood by ' , receiver printString +! ! + +!MessageNotUnderstood methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isResumable + ^message notNil and: [receiver respondsTo: message selector] +! ! + +!MessageNotUnderstood methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +message + ^message +! ! + +!MessageNotUnderstood methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +message: aMessage + message := aMessage +! ! + +!MessageNotUnderstood methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: self class name withArticle. + message ifNotNil: [ + aStream + cr; nextPutAll: 'selector: '; print: message selector; + cr; nextPutAll: 'arguments: '; print: message arguments]. + receiver ifNotNil: [ + aStream cr; nextPutAll: 'receiver: '; print: receiver]. + aStream cr. +! ! + +!MessageNotUnderstood methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver + ^receiver +! ! + +!MessageNotUnderstood methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject + receiver := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MessageNotUnderstood class' category: #Kernel! +MessageNotUnderstood class + instanceVariableNames: ''! + +!MessageNotUnderstood class methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +message: aMessage + ^self new message: aMessage; signal +! ! + +!MessageNotUnderstood class methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +message: aMessage receiver: anObject + ^self new message: aMessage; receiver: anObject; signal +! ! + + diff --git a/modules/Kernel/MessageSend.Class.st b/modules/Kernel/MessageSend.Class.st new file mode 100644 index 00000000..52bc75d9 --- /dev/null +++ b/modules/Kernel/MessageSend.Class.st @@ -0,0 +1,112 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #MessageSend category: #Kernel! +Message subclass: #MessageSend + instanceVariableNames: 'receiver' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!MessageSend commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!MessageSend methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aMessage + super = aMessage ifFalse: [^false]. + ^self receiver == aMessage receiver +! ! + +!MessageSend methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluate + ^self perform +! ! + +!MessageSend methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateFor: anObject + ^self evaluateWithArguments: {anObject} +! ! + +!MessageSend methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWith: argObject + ^selector arity = 1 + ifTrue: [receiver perform: selector with: argObject] + ifFalse: [super evaluateWith: argObject] +! ! + +!MessageSend methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWithArguments: anArray + | args | + args := self buildArguments: anArray. + ^receiver perform: selector withArguments: args +! ! + +!MessageSend methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^receiver hashWith: selector with: arguments +! ! + +!MessageSend methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +newProcess + ^Process new evaluating: self +! ! + +!MessageSend methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +perform + ^self performOn: receiver +! ! + +!MessageSend methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream + nextPutAll: self class name; + nextPut: $(; + nextPutAll: receiver class printString; + nextPutAll: '>>'; + nextPutAll: selector printString; + nextPut: $) +! ! + +!MessageSend methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver + ^receiver +! ! + +!MessageSend methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject + receiver := anObject +! ! + +!MessageSend methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject selector: aSymbol arguments: anArray + receiver := anObject. + selector := aSymbol. + arguments := anArray +! ! + +!MessageSend methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +value + ^self perform +! ! + +!MessageSend methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: value1 value: value2 + arguments + at: 1 put: value1; + at: 2 put: value2. + ^self perform +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MessageSend class' category: #Kernel! +MessageSend class + instanceVariableNames: ''! + +!MessageSend class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +receiver: anObject selector: aSymbol arguments: anArray + ^self new receiver: anObject selector: aSymbol arguments: anArray +! ! + + diff --git a/modules/Kernel/Metaclass.Class.st b/modules/Kernel/Metaclass.Class.st new file mode 100644 index 00000000..a3430292 --- /dev/null +++ b/modules/Kernel/Metaclass.Class.st @@ -0,0 +1,133 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Metaclass category: #Kernel! +Species subclass: #Metaclass + instanceVariableNames: 'class' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Metaclass commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Metaclass class' category: #Kernel! +Metaclass class + instanceVariableNames: ''! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name + ^class name , ' class' +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +beSubclassOf: aClass + | md | + format := aClass format. + superclass := aClass. + md := MethodDictionary new: 2. + instanceBehavior := Behavior with: md withAll: aClass instanceBehavior. + instanceBehavior classBinding: self. + class := self new +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVariables + ^class classVariables +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVarNames + ^class classVarNames +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +comment + ^class comment +! ! + +!Metaclass methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +duplicateHierarchyFrom: aClass with: aClassCopy + ^(class duplicateHierarchyFrom: aClass with: aClassCopy) class +! ! + +!Metaclass methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^class hash +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instanceClass + ^class +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instanceClass: aClass + class := aClass +! ! + +!Metaclass methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMetaclass + ^true +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name + ^class name , ' class' +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +namespace + ^class namespace +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +module + ^class module +! ! + +!Metaclass methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +shouldBeHidden: aSymbol + ^class shouldBeHidden: aSymbol +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +subclasses + ^class subclasses collect: [:cls | cls class] +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +subclasses: aCollection + " + do nothing + " + +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +subclassesDo: aBlock + class isNil ifTrue: [^self]. + class subclasses + select: [:cls | cls notNil] + thenDo: [:cls | aBlock value: cls class] +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +subspecies + ^self subclasses +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +subspeciesDo: aBlock + self subclassesDo: aBlock +! ! + +!Metaclass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +symbol + ^self name asSymbol +! ! + + diff --git a/modules/Kernel/MethodDictionary.Class.st b/modules/Kernel/MethodDictionary.Class.st new file mode 100644 index 00000000..bcd51c2c --- /dev/null +++ b/modules/Kernel/MethodDictionary.Class.st @@ -0,0 +1,131 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #MethodDictionary category: #Kernel! +IdentityDictionary subclass: #MethodDictionary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!MethodDictionary commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!MethodDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: aSymbol put: aCompiledMethod + | current | + current := self at: aSymbol ifAbsent: nil. + (current notNil and: [current isNativized]) + ifTrue: [aCompiledMethod prepareForExecution]. + self at: aSymbol putWithoutFlushing: aCompiledMethod. + aSymbol flushCacheFor: self classBinding. + ^aCompiledMethod +! ! + +!MethodDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: aSymbol putWithoutFlushing: aCompiledMethod + aCompiledMethod canBeInstalled + ifTrue: [self basicAt: aSymbol put: aCompiledMethod] +! ! + +!MethodDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: aSymbol put: aCompiledMethod + [ + (table atKey: aSymbol put: aCompiledMethod) == nil + ifTrue: [self incrementTally]] evaluateAtomically. + ^aCompiledMethod +! ! + +!MethodDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicRemoveKey: aSymbol ifAbsent: aBlock + | copy | + (self includesKey: aSymbol) ifFalse: [^aBlock value]. + copy := MethodDictionary new. + self keysAndValuesDo: [:selector :cm | + selector == aSymbol + ifTrue: [cm flushFromCaches] + ifFalse: [copy basicAt: selector put: cm]]. + [ + table := copy contents owner: self. + tally := copy size] evaluateAtomically. + ^aSymbol +! ! + +!MethodDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +classBinding + ^self isEmpty ifFalse: [self anyone classBinding]. +! ! + +!MethodDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +contentOfSize: anInteger + | modulo | + modulo := self moduloFor: anInteger. + ^(self bucketClass basicNew: modulo * 2) owner: self +! ! + +!MethodDictionary methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copy + ^self objectShallowCopy postCopy +! ! + +!MethodDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +flushCache + | class | + class := self classBinding. + self keysDo: [:selector | selector flushCacheFor: class] +! ! + +!MethodDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashFor: object + ^object basicHash +! ! + +!MethodDictionary methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMethodDictionary + ^true +! ! + +!MethodDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +moduloFor: size + | last powers | + powers := #(4 8 16 32 64 128 256 512 1024 2048 4096). + powers do: [:number | size < number ifTrue: [^number]]. + last := powers last. + [size < last] whileFalse: [last := last * 2]. + ^last +! ! + +!MethodDictionary methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +postCopy + table := table copy owner: self +! ! + +!MethodDictionary methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeKey: aSymbol ifAbsent: aBlock + ^Kernel removeKey: aSymbol from: self ifAbsent: aBlock +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MethodDictionary class' category: #Kernel! +MethodDictionary class + instanceVariableNames: ''! + +!MethodDictionary class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultSize + ^4 +! ! + +!MethodDictionary class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reserveSlot + self allInstances do: [:md | | selector cm | + selector := md contents at: 1. + cm := md contents at: 2. + selector notNil ifTrue: [md removeKey: selector]. + md contents at: 1 put: 0. + md incrementTally. + selector notNil ifTrue: [md at: selector put: cm]] +! ! + + diff --git a/modules/Kernel/Module.Class.st b/modules/Kernel/Module.Class.st new file mode 100644 index 00000000..7e2f2540 --- /dev/null +++ b/modules/Kernel/Module.Class.st @@ -0,0 +1,259 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Module category: #Kernel! +Object subclass: #Module + instanceVariableNames: 'name version exports namespace hash cachedLookups classes extensions overriden requires' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Module commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Module methodsFor: 'snapshotting' stamp: 'KenD 28/Jun/2026 13:27:38'! +prepareForSnapshot: aBuilder + aBuilder + importNilToken; + addBoundary: Symbol symbolTable as: SymbolicReference symbolTable; + map: overriden to: Dictionary new +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +addClass: aClass + classes add: aClass. + self exportClass: aClass +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +addExtension: aCompiledMethod + | collection | + collection := extensions at: aCompiledMethod classBinding symbol ifAbsentPut: [OrderedCollection new]. + collection add: aCompiledMethod. +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +addOverride: aCompiledMethod + overriden at: aCompiledMethod signature put: aCompiledMethod +! ! + +!Module methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicInitialize + name := self defaultName. + namespace ifNil: [namespace := Namespace new]. + exports := Set new. + cachedLookups := Dictionary new. + classes := OrderedCollection new. + extensions := Dictionary new. + overriden := Dictionary new. + requires := #() +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +bind + classes + reject: [:c | classes includes: c superclass] + thenDo: [:c | c superclass addSubclass: c]. + extensions keysAndValuesDo: [:s :methods | | meta key target | + meta := s endsWith: ' class'. + key := meta ifTrue: [(s trimTail: ' class') asSymbol] ifFalse: [s]. + target := namespace at: key ifAbsent: [self _halt]. + meta ifTrue: [target := target class]. + methods do: [:m | | current extension | + current := target compiledMethodAt: m selector. + extension := m asExtensionFor: self. + target addSelector: m selector withMethod: extension. + current notNil ifTrue: [current module addOverride: current]] + ] +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +bind: anObject as: aSymbol + namespace at: aSymbol put: anObject. + self justDefined: aSymbol +! ! + +!Module methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +bindAll: aDictionary + aDictionary keysAndValuesDo: [:symbol :value | + namespace at: symbol put: value. + self justDefined: symbol]. +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +bindKernelExports + | bindings | + bindings := Dictionary new. + { + Object. Class. Metaclass. CompiledMethod. + Array. OrderedCollection. Set. Dictionary. + SmallInteger. String. Character. + } do: [:class | + bindings at: class symbol put: class]. + bindings at: #Kernel put: Kernel. + self bindAll: bindings +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name + ^name +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name: aString + name := aString +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classes + ^classes +! ! + +!Module methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +classNamed: aString + ^classes detect: [:cls | cls name = aString ] ifNone: nil +! ! + +!Module methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultName + | classname | + classname := self class name. + (classname endsWith: 'Module') ifTrue: [^classname trimTail: 'Module']. + (classname beginsWith: 'Module') ifTrue: [^classname trimPrefix: 'Module']. + ^classname +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +exports + | result | + result := Dictionary new. + result at: '__module__' put: self. + exports do: [:name | | value | + value := namespace at: name. + result at: name put: value]. + ^result +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +export: anObject as: aSymbol + namespace at: aSymbol put: anObject. + exports add: aSymbol +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +exportClass: aClass + self export: aClass as: aClass name asSymbol +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +extensions + ^extensions +! ! + +!Module methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +extensionClasses + ^extensions keys + collect: [:s | | key | + key := (s endsWith: ' class') ifTrue: [(s trimTail: ' class') asSymbol] ifFalse: [s]. + namespace at: key ifAbsent: [Class new name: (s , '__Not_Found') asSymbol]] +! ! + +!Module methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isModule + ^true +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +import: moduleName + | module | + namespace at: moduleName ifPresent: [:loaded | ^loaded]. + module := Kernel load: moduleName. + self bind: module as: moduleName. + ^module +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +import: name from: moduleName + ^self import: name from: moduleName as: name +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +import: name from: moduleName as: newName + | module import | + module := Kernel load: moduleName. + import := module namespace at: name. + self bind: import as: newName +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +importDescriptor: descriptor + | moduleName token exportNames | + moduleName := descriptor key. + token := descriptor value. + exportNames := token isArray ifTrue: [token] ifFalse: [{token}]. + exportNames do: [:name | self import: name from: moduleName] +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +importRequiredModules + requires do: [:name | self import: name]. + self imports do: [:descriptor | self importDescriptor: descriptor] +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +imports + " + Returns an array of import descriptors. A descriptor can be: + - A composite symbol (i.e #Core.Modules.Writer) (NOT IMPLEMENTED YET). + - An association of module name and exported name (i.e #Core.Modules.JSON -> #Writer) + - An association of module name, exported name and rename (i.e. #Core.Modules.JSON -> (#Writer -> #JSONWriter)) (NOT IMPLEMENTED YET) + " + ^#() +! ! + +!Module methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +justDefined: aSymbol + | lookups | + lookups := cachedLookups at: aSymbol ifAbsent: [^nil]. + lookups do: [:lookup | lookup flush] +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +justLoaded + self bind +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +namespace + ^namespace +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +originalMethodFor: aCompiledMethod + aCompiledMethod module == self ifTrue: [^aCompiledMethod]. + ^overriden at: aCompiledMethod signature ifAbsent: nil +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +overriden + ^overriden +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +requires + ^requires +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Module class' category: #Kernel! +Module class + instanceVariableNames: ''! + +!Module class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self basicNew basicInitialize +! ! + + diff --git a/modules/Kernel/Namespace.Class.st b/modules/Kernel/Namespace.Class.st new file mode 100644 index 00000000..7a19825d --- /dev/null +++ b/modules/Kernel/Namespace.Class.st @@ -0,0 +1,40 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Namespace category: #Kernel! +Dictionary subclass: #Namespace + instanceVariableNames: 'parent' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Namespace commentStamp: '' prior: 0! + + Copyright (c) 2022 Javier Pimás. + See (MIT) license in root directory. +! + +!Namespace methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_namespaceLookup: aSymbol + | table | + table := namespace _basicAt: 2. + 2 + to: table _size + do: [:j | | assoc | + assoc := (table _basicAt: j). + assoc == nil ifFalse: [ + assoc key == aSymbol + ifTrue: [^table _basicAt: j + 1]]]. + ^nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Namespace class' category: #Kernel! +Namespace class + instanceVariableNames: ''! + +!Namespace class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^super new +! ! + + diff --git a/modules/Kernel/Notification.Class.st b/modules/Kernel/Notification.Class.st new file mode 100644 index 00000000..f83f2d36 --- /dev/null +++ b/modules/Kernel/Notification.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Notification category: #Kernel! +Exception subclass: #Notification + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Notification commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Notification methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultAction + ^nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Notification class' category: #Kernel! +Notification class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/Number.Class.st b/modules/Kernel/Number.Class.st new file mode 100644 index 00000000..31051f62 --- /dev/null +++ b/modules/Kernel/Number.Class.st @@ -0,0 +1,510 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Number category: #Kernel! +Magnitude subclass: #Number + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Number commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aNumber + ^self + aNumber negated +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +* aNumber + self subclassResponsibility +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +/ aNumber + self subclassResponsibility +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +// aNumber + self subclassResponsibility +! ! + +!Number methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +@ aNumber + ^Point x: self y: aNumber +! ! + +!Number methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +@- aNumber + ^Point x: self y: aNumber negated +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +\\ aNumber + ^self - (self // aNumber * aNumber) +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aNumber + self subclassResponsibility +! ! + +!Number methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<~ aNumber + aNumber isFloat ifTrue: [^self asFloat <~ aNumber]. + ^[self <= aNumber] on: Error do: [false] +! ! + +!Number methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>~ aNumber + aNumber isFloat ifTrue: [^self asFloat >~ aNumber]. + ^[self >= aNumber] on: Error do: [false] +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +abs + ^self < self class zero ifTrue: [self negated] ifFalse: [self] +! ! + +!Number methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +arcCos + ^Float pi / 2.0 - self arcSin +! ! + +!Number methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +arcSin + | y | + y := self asFloat. + (y between: -1.0 and: 1.0) ifFalse: [^self error: 'invalid receiver']. + y = 1.0 ifTrue: [^Number pi / 2.0]. + y = -1.0 ifTrue: [^Number pi / -2.0]. + ^(y / (1.0 - y squared) sqrt) arcTan +! ! + +!Number methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +arcTan + ^self asFloat arcTan +! ! + +!Number methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asInteger + ^self rounded +! ! + +!Number methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asParameter + ^self +! ! + +!Number methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asPoint + ^self @ self +! ! + +!Number methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asScaledDecimal + " + Number pi asScaledDecimal + " + ^self withPrecision: 8 +! ! + +!Number methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBePrintedAsLiteral + ^true +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +ceiling + | integer | + integer := self floor. + ^integer = self ifTrue: [integer] ifFalse: [integer + 1] +! ! + +!Number methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +cos + ^self asFloat cos +! ! + +!Number methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + ^self +! ! + +!Number methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +degreesToRadians + ^self asFloat degreesToRadians +! ! + +!Number methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +denominator + ^1 +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +even + ^self \\ 2 = 0 +! ! + +!Number methodsFor: 'logarithms' stamp: 'KenD 28/Jun/2026 13:27:38'! +exp + ^self asFloat exp +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +floor + ^self // 1 +! ! + +!Number methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +fractionPart + ^self - self truncated +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isInfinite + ^false +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isInfinity + ^false +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMinusInfinity + ^false +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isNaN + ^false +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isNumber + ^true +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isZero + ^self = self class zero +! ! + +!Number methodsFor: 'logarithms' stamp: 'KenD 28/Jun/2026 13:27:38'! +ln + ^self asFloat ln +! ! + +!Number methodsFor: 'logarithms' stamp: 'KenD 28/Jun/2026 13:27:38'! +log + ^self log: 10 +! ! + +!Number methodsFor: 'logarithms' stamp: 'KenD 28/Jun/2026 13:27:38'! +log: aNumber + ^self ln / aNumber ln +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +negated + ^0 - self +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +negative + ^self < self class zero +! ! + +!Number methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +numerator + ^self +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +odd + ^self even not +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +positive + ^self >= self class zero +! ! + +!Number methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printDecimals: decimals separatedBy: aString + | writer fraction integer | + decimals < 0 ifTrue: [self error: 'invalid number of digits']. + writer := '' writeStream. + integer := self truncated. + self > -1 & (self < 0) + ifTrue: [writer nextPutAll: '-0'] + ifFalse: [integer printOn: writer]. + decimals > 0 ifTrue: [writer nextPutAll: aString]. + fraction := (self - integer) abs. + integer := 0. + decimals timesRepeat: [| digit | + fraction := fraction - integer * 10. + integer := fraction // 1. + digit := Character digitValue: integer. + writer nextPut: digit]. + ^writer contents +! ! + +!Number methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printFraction: decimals + ^self printDecimals: decimals separatedBy: ActiveLocale decimalSeparator +! ! + +!Number methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + self subclassResponsibility +! ! + +!Number methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printWithDecimalPlaces: digits + | power rounded | + power := digits <= 9 + ifTrue: [ + #(1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000) + at: digits + 1] + ifFalse: [10 raisedToInteger: digits + 1]. + rounded := self roundTo: power reciprocal. + ^rounded printFraction: digits +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +quo: aNumber + ^(self / aNumber) truncated +! ! + +!Number methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +radiansToDegrees + ^self asFloat radiansToDegrees +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +raisedTo: aNumber + | n | + aNumber = 0 ifTrue: [^self raisedToInteger: 0]. + (self = 0 and: [aNumber > 0]) ifTrue: [^0]. + aNumber isInteger ifTrue: [^self raisedToInteger: aNumber]. + self positive ifTrue: [^(aNumber * self abs ln) exp]. + n := aNumber rounded. + aNumber = n ifTrue: [^(self raisedToInteger: n) asFloat]. + ^(ArithmeticError on: #raisedTo:) signalInvalidOperation +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +raisedToInteger: anInteger + | answer multiplier binary | + self = 1 ifTrue: [^self]. + anInteger isInteger ifFalse: [ + anInteger isInfinity ifTrue: [ + ^self > 1 ifTrue: [anInteger] ifFalse: [ + self >= 0 + ifTrue: [self class zero] + ifFalse: [self error: 'receiver is not positive']]]. + anInteger isMinusInfinity ifTrue: [ + ^self > 1 ifTrue: [self class zero] ifFalse: [ + self >= 0 + ifTrue: [anInteger negated] + ifFalse: [self error: 'receiver is not positive']]]. + self error: 'argument is not integer']. + anInteger < 0 ifTrue: [^(self raisedToInteger: 0 - anInteger) reciprocal]. + answer := self class multiplicativeIdentity. + anInteger = 0 ifTrue: [ + ^self = 0 + ifTrue: [(ArithmeticError on: #raisedToInteger:) signalInvalidOperation] + ifFalse: [1]]. + multiplier := self. + anInteger = 1 ifTrue: [^multiplier]. + anInteger = 2 ifTrue: [^multiplier squared]. + binary := anInteger. + [ + (binary bitAnd: 1) = 1 ifTrue: [answer := answer * multiplier]. + binary := binary bitShift: -1. + binary > 0] + whileTrue: [multiplier := multiplier squared]. + ^answer +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +rem: aNumber + | quo | + quo := self quo: aNumber. + ^self - (quo * aNumber) +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +rounded + ^self + self + self sign quo: 2 +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +roundTo: aNumber + ^self < 0 + ifTrue: [self - (aNumber / 2) truncateTo: aNumber] + ifFalse: [self + (aNumber / 2) truncateTo: aNumber] +! ! + +!Number methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +shallowCopy + ^self +! ! + +!Number methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sign + self > 0 ifTrue: [^1]. + self < 0 ifTrue: [^-1]. + ^0 +! ! + +!Number methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +sin + ^self asFloat sin +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +sqrt + ^self asFloat sqrt +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +squared + ^self * self +! ! + +!Number methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + self printOn: aStream +! ! + +!Number methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +strictlyPositive + ^self > self class zero +! ! + +!Number methodsFor: 'trigonometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +tan + ^self asFloat tan +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +timesTwoPower: anInteger + ^self asFloat timesTwoPower: anInteger +! ! + +!Number methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +to: stop + ^Interval from: self to: stop +! ! + +!Number methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +to: stop by: step + ^Interval from: self to: stop by: step +! ! + +!Number methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +to: stop by: step do: aBlock + | index | + step = 0 ifTrue: [self error: 'step cannot be zero']. + index := self. + step > 0 + ifTrue: [ + [index <= stop] whileTrue: [ + aBlock value: index. + index := index + step]] + ifFalse: [ + [stop <= index] whileTrue: [ + aBlock value: index. + index := index + step]] +! ! + +!Number methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +to: stop do: aBlock + | index | + index := self. + [index <= stop] whileTrue: [ + aBlock value: index. + index := index + 1] +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncated + ^self truncateTo: 1 +! ! + +!Number methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncateTo: aNumber + ^(self quo: aNumber) * aNumber +! ! + +!Number methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +withPrecision: scale + ^ScaledDecimal fromNumber: self scale: scale +! ! + +!Number methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +zeroDivisorOn: aSymbol + ^ZeroDivide new operation: aSymbol; dividend: self; signal +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Number class' category: #Kernel! +Number class + instanceVariableNames: ''! + +!Number class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString + ^self fromString: aString decimalSeparator: '.' +! ! + +!Number class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString decimalSeparator: anotherString + | string special | + string := (aString includes: $.) + ifTrue: [aString] + ifFalse: [aString replaceAll: anotherString with: '.']. + (string notEmpty and: [string first = $.]) ifTrue: [string := '0' , string]. + special := string + reverseDetect: [:c | c = $. + or: [c = $/] + or: [c = $e] + or: [c = $E] + or: [c = $s]] + ifNone: nil. + special = $/ ifTrue: [^Fraction fromString: string]. + ^NumberParser new on: string; nextValue +! ! + +!Number class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +multiplicativeIdentity + ^1 +! ! + +!Number class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +nan + ^Float nan +! ! + +!Number class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self shouldNotImplement +! ! + +!Number class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self shouldNotImplement +! ! + +!Number class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +zero + ^0 +! ! + + diff --git a/modules/Kernel/NumberParser.Class.st b/modules/Kernel/NumberParser.Class.st new file mode 100644 index 00000000..c2c53f8b --- /dev/null +++ b/modules/Kernel/NumberParser.Class.st @@ -0,0 +1,235 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #NumberParser category: #Kernel! +Object subclass: #NumberParser + instanceVariableNames: 'stream error return' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!NumberParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +checkNumberEnd: position + | char | + stream atEnd ifTrue: [^self]. + char := stream peek. + char = $. ifFalse: [^self]. + stream skip: 1. + stream atEnd + ifFalse: [stream peek isDigit + ifTrue: [self error: 'invalid number' at: position]]. + stream skip: -1 +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +completeFloat: anInteger + | tenth | + tenth := 10 raisedToInteger: self nextExponent. + ^(anInteger * tenth) asFloat +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +completeNumber: anInteger after: aCharacter + aCharacter = $. ifTrue: [ + ^(stream peekFor: $s) + ifTrue: [self nextScaledFrom: anInteger fractionDigits: 0] + ifFalse: [self nextFloat: anInteger]]. + (aCharacter = $e or: [aCharacter = $E]) + ifTrue: [^self completeFloat: anInteger]. + aCharacter = $r ifTrue: [^self nextIntegerRadix: anInteger]. + aCharacter = $s ifTrue: [^self nextScaledFrom: anInteger fractionDigits: 0]. + (anInteger = 0 and: [aCharacter = $x or: [aCharacter = $X]]) + ifTrue: [^self nextIntegerRadix: 16]. + stream skip: -1. + ^anInteger +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +completeNumber: anInteger at: start + | number | + stream atEnd ifTrue: [^anInteger]. + number := anInteger. + number := self completeNumber: anInteger after: stream next. + self checkNumberEnd: start. + ^number +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +digitFromChar: char base: radix + | c | + char isDigit ifTrue: [^char digitValue]. + char = $r ifTrue: [^nil]. + char = $x ifTrue: [^nil]. + char = $X ifTrue: [^nil]. + c := char asUppercase. + (c asInteger between: $A asInteger and: $Z asInteger) ifFalse: [^nil]. + (c !!= $E and: [radix <= c digitValue]) ifTrue: [^nil]. + (c = $E and: [radix = 10]) ifTrue: [^nil]. + ^c digitValue +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +endToken + self error: 'end of stream' at: stream position +! ! + +!NumberParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +error + ^error +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +error: aString at: position + error := aString -> position. + return value: nil +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +negativeNumber + | position | + stream atEnd ifTrue: [^nil]. + stream peek isDigit ifFalse: [^nil]. + position := stream position. + ^self next key negated -> position +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +next + | char | + return isNil ifTrue: [return := [:value | ^value]]. + char := self nextChar. + char isNil ifTrue: [^self endToken]. + char = $- ifTrue: [^self negativeNumber]. + char = $+ ifTrue: [^self positiveNumber]. + char isDigit ifTrue: [^self nextNumber: char]. + ^nil +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextChar + ^stream skipWhitespace atEnd ifFalse: [stream next] +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextDigit: radix + | char digit | + stream atEnd ifTrue: [^nil]. + char := stream next. + digit := self digitFromChar: char base: radix. + digit isNil ifTrue: [ + stream skip: -1. + ^nil]. + radix <= digit + ifTrue: [self error: 'digit greater than radix' at: stream position]. + ^digit +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextExponent + | negated exp | + negated := false. + (stream peekFor: $+) ifFalse: [negated := stream peekFor: $-]. + exp := self nextIntegerRadix: 10. + negated ifTrue: [exp := exp negated]. + ^exp +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextFloat: aNumber + | base digit e exp | + digit := self nextDigit: 10. + digit isNil ifTrue: [ + stream skip: -1. + ^aNumber]. + e := 1. + base := aNumber * 10 + digit. + [ + digit := self nextDigit: 10. + digit isNil] + whileFalse: [ + base := base * 10 + digit. + e := e + 1]. + ((stream peekFor: $E) or: [stream peekFor: $e]) ifTrue: [ + exp := self nextExponent. + ^(base * (10 raisedToInteger: exp - e)) asFloat]. + (stream peekFor: $s) ifTrue: [^self nextScaledFrom: base fractionDigits: e]. + ^(base * (10 raisedToInteger: e negated)) asFloat +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextIntegerRadix: radix + | value valid digit | + value := 0. + valid := false. + [ + digit := self nextDigit: radix. + digit isNil] + whileFalse: [ + valid := true. + value := value * radix + digit]. + valid ifFalse: [self error: 'digit missing' at: stream position + 1]. + ^value +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextNumber: aCharacter + | start number digit | + start := stream position. + number := aCharacter digitValue. + [ + digit := self nextDigit: 10. + digit isNil] + whileFalse: [number := number * 10 + digit]. + number := self completeNumber: number at: start. + ^number -> (start thru: stream position) +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextScaledFrom: aNumber fractionDigits: digits + | scale denominator sd | + scale := (stream atEnd not and: [stream peek isDigit]) + ifTrue: [self nextIntegerRadix: 10]. + denominator := 10 raisedToInteger: digits. + sd := ScaledDecimal + numerator: aNumber + denominator: denominator + scale: scale. + ^sd reduced +! ! + +!NumberParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextValue + ^self next ifNil: [0] ifNotNil: [:assoc | assoc key] +! ! + +!NumberParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aString + stream := aString readStream. + return := nil +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +positiveNumber + | position | + stream peek isDigit ifFalse: [^nil]. + position := stream position. + ^self next key -> position +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reset + stream reset. + return := nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NumberParser class' category: #Kernel! +NumberParser class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/Object.Class.st b/modules/Kernel/Object.Class.st new file mode 100644 index 00000000..00f67d91 --- /dev/null +++ b/modules/Kernel/Object.Class.st @@ -0,0 +1,1117 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Object category: #Kernel! +ProtoObject subclass: #Object + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Object commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Object methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +-> anObject + ^Association key: self value: anObject +! ! + +!Object methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +!!= anObject + ^(self = anObject) not +! ! + +!Object methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +_replaceFrom: start to: end with: other + ^self _basicCopyFrom: start to: end with: other +! ! + +!Object methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +~ anObject + ^self isCloseTo: anObject +! ! + +!Object methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +~= anObject + ^(self = anObject) not +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +actionForEvent: aSymbol + ^self eventAt: aSymbol ifAbsent: nil +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +actionsForEvent: aSymbol + | action | + action := self eventAt: aSymbol ifAbsent: [^ActionSequence new]. + ^action asActionSequence +! ! + +!Object methodsFor: 'instance behavior' stamp: 'KenD 28/Jun/2026 13:27:38'! +addInstanceMethods: aMethodDictionary + | behavior | + behavior := self behavior enhancedWith: aMethodDictionary. + self behavior: behavior +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +asActionSequence + ^ActionSequence with: self +! ! + +!Object methodsFor: 'inspecting' stamp: 'KenD 28/Jun/2026 13:27:38'! +aspects + ^self class aspects +! ! + +!Object methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:27:38'! +ASSERT: aBoolean + aBoolean value ifFalse: [AssertionFailure signal]. + ^aBoolean +! ! + +!Object methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asString + ^self printString +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger + ^self primitiveAt: anInteger +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: anObject + ^self primitiveAt: anInteger put: anObject +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: anInteger + ^self at: anInteger +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +beWeak + self _beSpecial +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +beWeak: aBoolean + aBoolean ifTrue: [self _beSpecial] ifFalse: [self _beNotSpecial] +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +bindEventTable: aDictionary + ^Smalltalk bindEventTable: aDictionary to: self +! ! + +!Object methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: anInteger + ^self basicAt: anInteger +! ! + +!Object methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: anInteger put: byte + ^self basicAt: anInteger put: byte +! ! + +!Object methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAtValid: anInteger + ^self _byteAt: anInteger +! ! + +!Object methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAtValid: anInteger put: value + ^self _byteAt: anInteger put: value +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBePrintedAsLiteral + ^false +! ! + +!Object methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +cannotReturn + self error: 'Closure cannot return' +! ! + +!Object methodsFor: 'instance behavior' stamp: 'KenD 28/Jun/2026 13:27:38'! +changeClassTo: aClass + self class == aClass ifFalse: [self behavior: aClass instanceBehavior] +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +changed + self triggerEvent: #changed +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +changed: argument + self triggerEvent: #changed: with: argument +! ! + +!Object methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copy + ^self shallowCopy postCopy +! ! + +!Object methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + ^self objectDeepCopy postCopy +! ! + +!Object methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:27:38'! +DENY: aBoolean + aBoolean value ifTrue: [AssertionFailure signal]. + ^aBoolean +! ! + +!Object methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:27:38'! +disableCode: aBlock + "do not evaluate the code inside the block" +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +ensurePropertyTable + ^Kernel ensurePropertyTableFor: self +! ! + +!Object methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluate + ^self +! ! + +!Object methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWith: anObject + ^self evaluateWithArguments: {anObject} +! ! + +!Object methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWith: arg1 with: arg2 + ^self evaluateWithArguments: {arg1. arg2} +! ! + +!Object methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWithArguments: anArray + ^self evaluate +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +eventAt: aSymbol ifAbsent: aBlock + | table | + table := self eventTable ifNil: [^aBlock value]. + ^table at: aSymbol asSymbol ifAbsent: aBlock +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +eventAt: aSymbol put: action + | table | + table := self eventTable. + table isNil ifTrue: [ + table := IdentityDictionary new: 1. + self bindEventTable: table]. + table at: aSymbol asSymbol put: action +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +eventTable + ^Smalltalk eventTableFor: self +! ! + +!Object methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:38'! +finalize: anObject + +! ! + +!Object methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:27:38'! +halt: errorMessage + Halt signal: errorMessage +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +handledEvents + | table | + table := self eventTable. + table isNil ifTrue: [^#()]. + ^table keys +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasActionForEvent: aSymbol + | table | + table := self eventTable ifNil: [^false]. + ^table includesKey: aSymbol asSymbol +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasBytes + ^self isBytes +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasInstanceBehavior + ^self behavior isInstanceBehavior +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash: anInteger + self basicHash: anInteger +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashedWith: a with: b with: c with: d with: e with: f count: n + | hash | + hash := n hashMultiply bitXor: self hash. + hash := hash hashMultiply bitXor: a hash. + n = 2 ifTrue: [^hash]. + hash := hash hashMultiply bitXor: b hash. + n = 3 ifTrue: [^hash]. + hash := hash hashMultiply bitXor: c hash. + n = 4 ifTrue: [^hash]. + hash := hash hashMultiply bitXor: d hash. + n = 5 ifTrue: [^hash]. + hash := hash hashMultiply bitXor: e hash. + n = 6 ifTrue: [^hash]. + hash := hash hashMultiply bitXor: f hash. + n = 7 ifTrue: [^hash]. + self error: 'Invalid argument count' +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashWith: a + ^self + hashedWith: a + with: nil + with: nil + with: nil + with: nil + with: nil + count: 2 +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashWith: a with: b + ^self + hashedWith: a + with: b + with: nil + with: nil + with: nil + with: nil + count: 3 +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashWith: a with: b with: c + ^self + hashedWith: a + with: b + with: c + with: nil + with: nil + with: nil + count: 4 +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashWith: a with: b with: c with: d + ^self + hashedWith: a + with: b + with: c + with: d + with: nil + with: nil + count: 5 +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashWith: a with: b with: c with: d with: e + ^self + hashedWith: a + with: b + with: c + with: d + with: e + with: nil + count: 6 +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashWith: a with: b with: c with: d with: e with: f + ^self + hashedWith: a + with: b + with: c + with: d + with: e + with: f + count: 7 +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasRegisteredEvent: aSymbol + ^self class hasRegisteredEvent: aSymbol +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifNil: aBlock ifNotNil: anotherBlock + " + This method is inlined + " + ^anotherBlock evaluateWith: self +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifNotNil: aBlock ifNil: anotherBlock + " + This method is inlined + " + ^aBlock evaluateWith: self +! ! + +!Object methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +imageSegment + ^ImageSegment segmentAt: self _oop +! ! + +!Object methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isArray + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isAssociation + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBlock + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBlockClosure + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBoolean + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBytes + ^self class isBytes +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isByteArray + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCharacter + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isClass + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isClosure + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCollection + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCompiledMethod + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDate + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDictionary + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDirectory + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmptyOrNil + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFile + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFilename + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFileStream + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFixedObject + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFloat + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFraction + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isInKernel + ^ImageSegment kernel includesAddress: self _oop +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isInSegment + ^self imageSegment ifNil: [false] ifNotNil: [:bsl | bsl ordinal > 1] +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isInteger + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isKindOf: aClass + ^self class inheritsFrom: aClass +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isLargeInteger + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMemberOf: aClass + ^self class == aClass +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMemoryBuffer + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMessage + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMetaclass + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMethodDictionary + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isModule + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isNativeCode + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isNumber + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isPoint + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isRectangle + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSequenceableCollection + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSmallInteger + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSpecies + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isStream + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isString + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSymbol + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isTime + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isTimestamp + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWideString + ^false +! ! + +!Object methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWideSymbol + ^false +! ! + +!Object methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +literalString + ^self canBePrintedAsLiteral ifTrue: [self storeString] +! ! + +!Object methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +marshalOn: aStream + | s | + s := self sizeInBytes. + aStream putBytesFrom: self from: 1 to: s. + s < WordSize + ifTrue: [aStream putBytesFrom: #[0 0 0 0 0 0 0 0] from: 1 to: WordSize - s] +! ! + +!Object methodsFor: 'instance behavior' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodFor: aSymbol + ^self behavior findMethodFor: aSymbol +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodFor: aSymbol in: aClass + ^self behavior findMethodFor: aSymbol in: aClass +! ! + +!Object methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +mustBeBoolean + ^Error signal: 'not a Boolean receiver' +! ! + +!Object methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +objectDeepCopy + | class ivars copy | + class := self class. + class _instancesAreFixed + ifTrue: [ + ivars := 0. + copy := class basicNew] + ifFalse: [ + ivars := self basicSize. + copy := class basicNew: ivars]. + class _instancesHavePointers + ifTrue: [ + 1 to: ivars + class instSize do: [:index | | ivar | + ivar := self instVarAt: index. + copy instVarAt: index put: ivar copy]] + ifFalse: [ + 1 to: ivars do: [:index | | byte | + byte := self basicAt: index. + copy basicAt: index put: byte]]. + ^copy +! ! + +!Object methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +objectShallowCopy + | copy class | + class := self class. + copy := class _instancesAreArrayed + ifTrue: [class basicNew: self basicSize] + ifFalse: [class basicNew]. + self shallowCopyTo: copy. + ^copy +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +onEvent: aSymbol do: anActionSequence + anActionSequence compressed + ifNil: [self removeActionsForEvent: aSymbol] + ifNotNil: [:action | self eventAt: aSymbol asSymbol put: action] +! ! + +!Object methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +oop + ^self _oop +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +perform: aSymbol with: firstObject with: secondObject + ^self perform: aSymbol withArguments: {firstObject. secondObject} +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +perform: aSymbol with: arg1 with: arg2 with: arg3 + ^self perform: aSymbol withArguments: {arg1. arg2. arg3} +! ! + +!Object methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +postCopy + +! ! + +!Object methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: self class name withArticle +! ! + +!Object methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +propertyAt: aSymbol + ^self propertyTable at: aSymbol ifAbsent: nil +! ! + +!Object methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +propertyAt: aSymbol ifAbsent: aBlock + ^self propertyTable at: aSymbol ifAbsent: aBlock +! ! + +!Object methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +propertyAt: aSymbol ifAbsentPut: aBlock + self ensurePropertyTable. + ^self propertyTable at: aSymbol ifAbsentPut: aBlock +! ! + +!Object methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +propertyAt: aSymbol put: anObject + self ensurePropertyTable. + ^self propertyTable at: aSymbol put: anObject +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +propertyTable + ^(Kernel propertiesFor: self) ifNil: [IdentityDictionary new] +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +registeredEvents + ^self class registeredEvents +! ! + +!Object methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:38'! +release + self releaseEventTable +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +releaseEventTable + self bindEventTable: nil +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAction: anAction forEvent: aSymbol + self + removeActionsSatisfying: [:action | action = anAction] + forEvent: aSymbol +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeActionsForEvent: eventName + | table | + table := self eventTable. + table isNil ifTrue: [^self]. + table removeKey: eventName asSymbol ifAbsent: []. + table isEmpty ifTrue: [self releaseEventTable] +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeActionsSatisfying: aBlock forEvent: aSymbol + | actions | + actions := (self actionsForEvent: aSymbol) + reject: [:action | aBlock value: action]. + self onEvent: aSymbol do: actions +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeActionsWithReceiver: anObject forEvent: aSymbol + self + removeActionsSatisfying: [:action | (action respondsTo: #receiver) + and: [action receiver == anObject]] + forEvent: aSymbol +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAllActionsFor: anObject + self handledEvents + do: [:event | self removeActionsWithReceiver: anObject forEvent: event] +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeDependent: anObject + self removeActionsWithReceiver: anObject forEvent: #changed +! ! + +!Object methodsFor: 'instance behavior' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeInstanceBehavior + self behavior: self class instanceBehavior +! ! + +!Object methodsFor: 'instance behavior' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeMethods: aMethodDictionary + | behavior copy | + self hasInstanceBehavior ifFalse: [^self]. + behavior := self behavior. + copy := behavior copyWithout: aMethodDictionary. + copy == behavior ifFalse: [self behavior: copy] +! ! + +!Object methodsFor: 'accessing-properties' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeProperty: aSymbol + self + removeProperty: aSymbol + ifAbsent: [self error: 'property is not in the collection'] +! ! + +!Object methodsFor: 'accessing-properties' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeProperty: aSymbol ifAbsent: aBlock + | t | + t := Kernel propertiesFor: self. + t notNil ifTrue: [t removeKey: aSymbol ifAbsent: aBlock] +! ! + +!Object methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceBytesBackwardFrom: stop to: start with: aCollection startingAt: position + | i j | + i := stop. + j := position. + [start <= i] whileTrue: [ + self byteAt: i put: (aCollection byteAt: j). + i := i - 1. + j := j - 1] +! ! + +!Object methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceBytesForwardFrom: start to: stop with: aCollection startingAt: position + | i j | + i := start. + j := position. + [i <= stop] whileTrue: [ + self byteAt: i put: (aCollection byteAt: j). + i := i + 1. + j := j + 1] +! ! + +!Object methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceBytesFrom: start to: stop with: aCollection startingAt: position + | end | + (self == aCollection and: [ + end := position + stop - start. + start between: position and: end]) + ifTrue: [ + self + replaceBytesBackwardFrom: stop + to: start + with: aCollection + startingAt: end] + ifFalse: [ + self + replaceBytesForwardFrom: start + to: stop + with: aCollection + startingAt: position] +! ! + +!Object methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +respondsTo: aSymbol + | cm | + cm := self methodFor: aSymbol. + ^cm !!== nil +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +sender + ^StackFrameCursor top moveNext moveNext receiver +! ! + +!Object methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:38'! +sessionShutdown + " + Default is do nothing. + " + +! ! + +!Object methodsFor: 'startup' stamp: 'KenD 28/Jun/2026 13:27:38'! +sessionStartup + ^self +! ! + +!Object methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +shallowCopy + ^self objectShallowCopy +! ! + +!Object methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +shallowCopyTo: anObject + | n | + self class isBytes ifTrue: [ + anObject class isBytes ifFalse: [self error: 'cannot copy']. + n := self sizeInBytes min: anObject sizeInBytes. + 1 to: n do: [:i | | byte | + byte := self byteAt: i. + anObject byteAt: i put: byte]. + ^anObject]. + anObject class isBytes ifTrue: [self error: 'cannot copy']. + n := self class instSize min: anObject class instSize. + 1 to: n do: [:index | | slot | + slot := self instVarAt: index. + anObject instVarAt: index put: slot]. + self class _instancesAreArrayed ifTrue: [ + n := self basicSize min: anObject basicSize. + 1 to: n do: [:index | | slot | + slot := self basicAt: index. + anObject basicAt: index put: slot]]. + ^anObject +! ! + +!Object methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +shouldNotImplement + self error: 'inappropriate message for this object' +! ! + +!Object methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self primitiveSize +! ! + +!Object methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + self _isBytes ifFalse: [^nil]. + ^self _size +! ! + +!Object methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +species + ^self class +! ! + +!Object methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + | class yourself | + Recursion checkOn: self while: [ + class := self class. + aStream + nextPutAll: '(('; + nextPutAll: class name; + nextPutAll: ' basicNew'. + class _instancesAreArrayed ifTrue: [ + aStream nextPut: $:. + self basicSize printOn: aStream]. + aStream nextPut: $). + yourself := false. + (1 to: class instSize + self basicSize) + do: [:i | | ivar | + yourself := true. + aStream nextPutAll: ' instVarAt: '. + i printOn: aStream. + aStream nextPutAll: ' put: '. + ivar := self instVarAt: i. + ivar storeOn: aStream] + separatedBy: [aStream nextPutAll: '; ']. + yourself ifTrue: [aStream nextPutAll: '; yourself']. + aStream nextPut: $)] +! ! + +!Object methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeString + | stream | + stream := '' writeStream. + self storeOn: stream. + ^stream contents +! ! + +!Object methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +subclassResponsibility + ^self error: 'subclass responsibility' +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +triggerEvent: aSymbol + ^self triggerEvent: aSymbol withArguments: #() defaultHandler: nil +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +triggerEvent: aSymbol defaultHandler: aBlock + ^self triggerEvent: aSymbol withArguments: #() defaultHandler: aBlock +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +triggerEvent: aSymbol with: anObject + ^self triggerEvent: aSymbol withArguments: {anObject} defaultHandler: nil +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +triggerEvent: aSymbol with: anObject defaultHandler: aBlock + ^self + triggerEvent: aSymbol + withArguments: {anObject} + defaultHandler: aBlock +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +triggerEvent: aSymbol with: anObject with: anotherObject + ^self triggerEvent: aSymbol withArguments: {anObject. anotherObject} +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +triggerEvent: aSymbol with: arg1 with: arg2 defaultHandler: aBlock + ^self + triggerEvent: aSymbol + withArguments: {arg1. arg2} + defaultHandler: aBlock +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +triggerEvent: aSymbol withArguments: aCollection + ^self triggerEvent: aSymbol withArguments: aCollection defaultHandler: nil +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +triggerEvent: aSymbol withArguments: aCollection defaultHandler: aBlock + | action | + action := self eventAt: aSymbol ifAbsent: [^aBlock value]. + ^action evaluateWithArguments: aCollection +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +unregisteredEvent: aSymbol + ^self error: 'Unregistered event ' , aSymbol storeString +! ! + +!Object methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +value + ^self +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +when: aSymbol do: aBlock + self when: aSymbol evaluate: aBlock +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +when: aSymbol evaluate: action + | actions | + (self hasRegisteredEvent: aSymbol) ifFalse: [self + unregisteredEvent: aSymbol]. + actions := self actionsForEvent: aSymbol. + (actions includes: action) ifTrue: [^self]. + actions := actions copyWith: action. + self onEvent: aSymbol do: actions +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +when: event send: selector to: receiver + | args msg | + args := Array new: selector arity. + msg := EventHandlerMessage + receiver: receiver + selector: selector asSymbol + arguments: args. + self when: event evaluate: msg +! ! + +!Object methodsFor: 'event handling' stamp: 'KenD 28/Jun/2026 13:27:38'! +when: event send: selector to: receiver with: argument + | arguments msg | + arguments := Array new: selector arity. + arguments at: arguments size put: argument. + msg := EventHandlerMessage + receiver: receiver + selector: selector + arguments: arguments. + self when: event evaluate: msg +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Object class' category: #Kernel! +Object class + instanceVariableNames: ''! + +!Object class methodsFor: 'inspecting' stamp: 'KenD 28/Jun/2026 13:27:38'! +aspects + ^#() +! ! + +!Object class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +availableEvents + ^Set with: #changed with: #changed: +! ! + +!Object class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasRegisteredEvent: aSymbol + ^self registeredEvents includes: aSymbol asSymbol +! ! + +!Object class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +registeredEvents + | events | + events := Smalltalk registeredEventsFor: self. + events isNil ifTrue: [self registerEvents]. + ^Smalltalk registeredEventsFor: self +! ! + +!Object class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +registerEvents + Smalltalk register: self availableEvents for: self +! ! + + +Object initialize! + diff --git a/modules/Kernel/ObjectReference.Class.st b/modules/Kernel/ObjectReference.Class.st new file mode 100644 index 00000000..673e0cd4 --- /dev/null +++ b/modules/Kernel/ObjectReference.Class.st @@ -0,0 +1,116 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ObjectReference category: #Kernel! +Object subclass: #ObjectReference + instanceVariableNames: 'source sourceOffset target absolute' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ObjectReference commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ObjectReference methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! +beAbsolute + absolute := true +! ! + +!ObjectReference methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! +classBinding + ^source classBinding +! ! + +!ObjectReference methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +for: anObject + self target: anObject +! ! + +!ObjectReference methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + absolute := false +! ! + +!ObjectReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isAbsolute + ^absolute +! ! + +!ObjectReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMethod + ^false +! ! + +!ObjectReference methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: 'Ref to ' , target printString +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +source: sourceObject + source := sourceObject +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sourceOffset + ^sourceOffset +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sourceOffset: aNumber + sourceOffset := aNumber +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +target + ^target +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +target: anObject + target := anObject +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +targetOffset + ^0 +! ! + +!ObjectReference methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueToWriteAt: sourceAddress targeting: targetAddress with: wordSize + | address correction | + address := targetAddress + self targetOffset. + correction := absolute + ifTrue: [0] + ifFalse: [sourceAddress + sourceOffset + wordSize]. + ^address - correction +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueToWriteAt: sourceAddress with: wordSize + ^self + valueToWriteAt: sourceAddress + targeting: target _asSmallInteger + with: wordSize +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueToWriteWith: wordSize + ^self valueToWriteAt: source _asSmallInteger + sourceOffset with: wordSize +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ObjectReference class' category: #Kernel! +ObjectReference class + instanceVariableNames: ''! + +!ObjectReference class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +absoluteFor: anObject + ^(self new for: anObject) beAbsolute +! ! + + +ObjectReference initialize! + diff --git a/modules/Kernel/OpenHashTable.Class.st b/modules/Kernel/OpenHashTable.Class.st new file mode 100644 index 00000000..a0e106da --- /dev/null +++ b/modules/Kernel/OpenHashTable.Class.st @@ -0,0 +1,126 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #OpenHashTable category: #Kernel! +HashTable subclass: #OpenHashTable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!OpenHashTable commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OpenHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index key: key put: element + | object | + object := self at: index. + object == self emptySlot ifTrue: [object := nil]. + object == nil ifTrue: [self at: index put: element]. + ^object +! ! + +!OpenHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atKey: key hash: hash sum: magnitude + | index object assoc sum | + index := self indexOfKey: key hash: hash. + object := self at: index. + (object == nil or: [object == self emptySlot]) ifTrue: [ + assoc := self associationClass key: key value: magnitude. + self at: index put: assoc. + ^nil]. + sum := object value + magnitude. + object value: sum. + ^object +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAtKey: key put: element + | index | + index := self indexOfKey: key. + self at: index put: element +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyAssociations + self + withIndexDo: [:a :index | a isAssociation + ifTrue: [self at: index put: a key -> a value]] +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyFromBucket: bucket + | count | + count := 0. + bucket elementsDo: [:element | | key | + count := count + 1. + key := self keyFor: element. + self basicAtKey: key put: element]. + ^count +! ! + +!OpenHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +count + ^self count: [:n | n notNil] +! ! + +!OpenHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +elementsDo: aBlock count: n + | i empty | + n = 0 ifTrue: [^self]. + i := 0. + empty := self emptySlot. + 1 to: self size do: [:index | | value | + value := self at: index. + value == nil | (value == empty) ifFalse: [ + value := value == NilToken ifFalse: [value]. + aBlock evaluateWith: value. + i := i + 1. + i = n ifTrue: [^self]]] +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfHash: integer + ^integer \\ self size + 1 +! ! + +!OpenHashTable methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCapacityGreaterThan: count + ^self size * 75 > (count * 100) +! ! + +!OpenHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +keysAndValuesDo: aBlock + self + elementsDo: [:assoc | aBlock evaluateWith: assoc key with: assoc value] +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookupValue: key + ^self lookupValue: key ifAbsent: [self keyNotFound: key] +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookupValue: key ifAbsent: aBlock + | assoc | + assoc := super lookupValue: key ifAbsent: [^aBlock value]. + ^assoc value +! ! + +!OpenHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +moveSlot: anInteger to: targetInteger + | a | + a := self basicAt: anInteger. + self + basicAt: anInteger put: self emptySlot; + basicAt: targetInteger put: a +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OpenHashTable class' category: #Kernel! +OpenHashTable class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/OrderedCollection.Class.st b/modules/Kernel/OrderedCollection.Class.st new file mode 100644 index 00000000..59b68cb0 --- /dev/null +++ b/modules/Kernel/OrderedCollection.Class.st @@ -0,0 +1,496 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #OrderedCollection category: #Kernel! +SequenceableCollection subclass: #OrderedCollection + instanceVariableNames: 'start end contents' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!OrderedCollection commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OrderedCollection methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +, aCollection + aCollection isCollection ifFalse: [super , aCollection]. + ^self copy addAll: aCollection; yourself +! ! + +!OrderedCollection methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +absentElement + ^self error: 'element not found' +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject + ^self basicAdd: anObject +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject after: anotherObject + | index | + index := self indexOf: anotherObject ifAbsent: [^self absentElement]. + ^self add: anObject afterIndex: index +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject afterIndex: anInteger + self makeRoomBehind: anInteger. + ^self at: anInteger + 1 put: anObject +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject at: anInteger + self makeRoomBehind: anInteger - 1. + ^contents at: start + anInteger - 1 put: anObject +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject before: anotherObject + | index | + index := self indexOf: anotherObject ifAbsent: [^self absentElement]. + ^self add: anObject beforeIndex: index +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject beforeIndex: anInteger + self makeRoomBehind: anInteger - 1. + ^self at: anInteger put: anObject +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addAll: aCollection + ^aCollection isSequenceableCollection + ifTrue: [self addAllLast: aCollection] + ifFalse: [super addAll: aCollection] +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addAllFirst: aCollection + | pending n | + pending := aCollection size. + [| free | + free := start - 1. + (pending > 0 and: [free = 0]) ifTrue: [ + self makeRoomBefore. + free := start - 1]. + n := free min: pending. + n > 0] + whileTrue: [ + contents + replaceFrom: start - n + to: start - 1 + with: aCollection + startingAt: pending - n + 1. + start := start - n. + pending := pending - n]. + ^aCollection +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addAllLast: aCollection + | index m n | + index := 1. + m := aCollection size. + [| free pending | + pending := m - index + 1. + free := contents size - end. + (pending > 0 and: [free = 0]) ifTrue: [ + start > 1 ifTrue: [self compact] ifFalse: [self grow]. + free := contents size - self size]. + n := free min: pending. + n > 0] + whileTrue: [ + contents + replaceFrom: end + 1 + to: end + n + with: aCollection + startingAt: index. + end := end + n. + index := index + n]. + ^aCollection +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addFirst: anObject + start = 1 ifTrue: [self makeRoomBefore]. + start := start - 1. + contents at: start put: anObject. + ^anObject +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addLast: anObject + ^self basicAdd: anObject +! ! + +!OrderedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +allButIndex: anInteger + ^self copy removeIndex: anInteger +! ! + +!OrderedCollection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asOrderedCollection + ^self +! ! + +!OrderedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger + ^self at: anInteger ifAbsent: [self outOfBoundsIndex: anInteger] +! ! + +!OrderedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger ifAbsent: aBlock + | index | + index := anInteger + start - 1. + (start <= index and: [index <= end]) ifFalse: [^aBlock value]. + ^contents at: index +! ! + +!OrderedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: anObject + | index | + index := anInteger + start - 1. + (start <= index and: [index <= end]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^contents at: index put: anObject +! ! + +!OrderedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atAllPut: anObject + start to: end do: [:i | contents at: i put: anObject] +! ! + +!OrderedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: anInteger + ^contents at: anInteger + start - 1 +! ! + +!OrderedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAdd: anObject + end = contents size ifTrue: [self makeRoomBehind]. + end := end + 1. + contents at: end put: anObject. + ^anObject +! ! + +!OrderedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +collectionSize + ^end - start + 1 +! ! + +!OrderedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +compact + | size e | + start = 1 ifTrue: [^self]. + size := self size. + e := end. + contents + replaceFrom: 1 + to: size + with: contents + startingAt: start. + start := 1. + end := size. + contents replaceFrom: end + 1 to: e withObject: nil +! ! + +!OrderedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyFrom: startIndex to: endIndex + | n copy | + n := endIndex - startIndex + 1 max: 0. + copy := self species new: self size. + copy stretchTo: n. + ^copy replaceFrom: 1 to: n with: self startingAt: startIndex +! ! + +!OrderedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyWith: anObject + ^self copy add: anObject; yourself +! ! + +!OrderedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + start to: end do: [:i | aBlock evaluateWith: (contents at: i)] +! ! + +!OrderedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +grow + self growTo: contents size + self growSize +! ! + +!OrderedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +growTo: anInteger + | copy | + copy := contents class new: anInteger. + copy + replaceFrom: start + to: end + with: contents + startingAt: start. + contents := copy +! ! + +!OrderedCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +includes: anObject + start to: end do: [:i | anObject = (contents at: i) ifTrue: [^true]]. + ^false +! ! + +!OrderedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize: anInteger + start := 1. + end := 0. + contents := Array new: anInteger +! ! + +!OrderedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +makeRoomBefore + | n s | + n := self collectionSize. + end := end = contents size + ifTrue: [ + self grow. + contents size + end + 1 // 2] + ifFalse: [contents size]. + s := start. + start := end - n + 1. + contents + replaceFrom: start + to: end + with: contents + startingAt: s; + replaceFrom: s to: start - 1 withObject: nil +! ! + +!OrderedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +makeRoomBehind + | s n e | + start = 1 ifTrue: [^self grow]. + s := start // 2. + n := self collectionSize. + e := end. + end := s + n - 1. + contents + replaceFrom: s + to: end + with: contents + startingAt: start; + replaceFrom: end + 1 to: e withObject: nil. + start := s +! ! + +!OrderedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +makeRoomBehind: anInteger + (anInteger = 0 and: [start > 1]) ifTrue: [ + start := start - 1. + ^self]. + end = contents size ifTrue: [self makeRoomBehind]. + end := end + 1. + contents + replaceFrom: start + anInteger + 1 + to: end + with: contents + startingAt: start + anInteger +! ! + +!OrderedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +pop + ^self removeLast +! ! + +!OrderedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +postCopy + contents := contents copy +! ! + +!OrderedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +push: anObject + ^self add: anObject +! ! + +!OrderedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: anObject ifAbsent: aBlock + start to: end do: [:i | + anObject = (contents at: i) ifTrue: [ + self removeIndex: i - start + 1. + ^anObject]]. + ^aBlock value +! ! + +!OrderedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAll + contents replaceFrom: start to: end withObject: nil. + start := 1. + end := 0 +! ! + +!OrderedCollection methodsFor: 'adding/removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAllSuchThat: aBlock + | n | + n := start. + start to: end do: [:index | | element | + element := contents at: index. + (aBlock value: element) ifFalse: [ + contents at: n put: element. + n := n + 1]]. + contents replaceFrom: n to: end withObject: nil. + end := n - 1. + end < start ifTrue: [ + start := 1. + end := 0] +! ! + +!OrderedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeFirst + | first | + start > end ifTrue: [^self absentElement]. + first := contents at: start. + contents at: start put: nil. + start := start + 1. + end < start ifTrue: [ + start := 1. + end := 0]. + ^first +! ! + +!OrderedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeIndex: anInteger + | absolute | + absolute := anInteger + start - 1. + (absolute between: start and: end) ifFalse: [^self absentElement]. + absolute <= (start + end // 2) + ifTrue: [ + contents + replaceFrom: start + 1 to: absolute with: contents startingAt: start; + at: start put: nil. + start := start + 1] + ifFalse: [ + contents + replaceFrom: absolute + to: end - 1 + with: contents + startingAt: absolute + 1; + at: end put: nil. + end := end - 1]. + end < start ifTrue: [ + start := 1. + end := 0] +! ! + +!OrderedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeLast + | last | + start > end ifTrue: [^self absentElement]. + last := contents at: end. + contents at: end put: nil. + end := end - 1. + end < start ifTrue: [ + start := 1. + end := 0]. + ^last +! ! + +!OrderedCollection methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceBackwardFrom: first to: last with: aCollection startingAt: position + contents + replaceBackwardFrom: start + first - 1 + to: start + last - 1 + with: aCollection + startingAt: position +! ! + +!OrderedCollection methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceForwardFrom: first to: last with: aCollection startingAt: position + contents + replaceForwardFrom: start + first - 1 + to: start + last - 1 + with: aCollection + startingAt: position +! ! + +!OrderedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: firstIndex to: lastIndex with: aCollection + | m d n e | + m := aCollection size. + d := lastIndex - firstIndex + 1. + n := self size - d + m. + n > contents size ifTrue: [self growTo: n // 2 + n]. + e := end. + end := contents size. + self + replaceFrom: firstIndex + m to: n with: self startingAt: lastIndex + 1; + replaceFrom: firstIndex + to: firstIndex + m - 1 + with: aCollection + startingAt: 1. + end := start + n - 1. + contents replaceFrom: e + m - d + 1 to: e withObject: nil +! ! + +!OrderedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self collectionSize +! ! + +!OrderedCollection methodsFor: 'sorting' stamp: 'KenD 28/Jun/2026 13:27:38'! +sortBy: aBlock + contents sort: start to: end with: aBlock +! ! + +!OrderedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +stretchTo: n + n < end ifTrue: [self error: 'invalid argument']. + end := n + start - 1 +! ! + +!OrderedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +stretchToContents + start := 1. + end := contents size +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OrderedCollection class' category: #Kernel! +OrderedCollection class + instanceVariableNames: ''! + +!OrderedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +from: anObject iterator: aSymbol + | new | + new := self new. + anObject perform: aSymbol with: [:element | new add: element]. + ^new +! ! + +!OrderedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self new: 10 +! ! + +!OrderedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self basicNew initialize: anInteger +! ! + +!OrderedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: size withAll: anObject + | instance | + instance := self new: size. + instance stretchToContents. + anObject notNil ifTrue: [instance atAllPut: anObject]. + ^instance +! ! + +!OrderedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: aCollection + | collection | + collection := self new: aCollection size. + collection addAll: aCollection. + ^collection +! ! + + diff --git a/modules/Kernel/OrderedDictionary.Class.st b/modules/Kernel/OrderedDictionary.Class.st new file mode 100644 index 00000000..b88fa0bc --- /dev/null +++ b/modules/Kernel/OrderedDictionary.Class.st @@ -0,0 +1,122 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #OrderedDictionary category: #Kernel! +Dictionary subclass: #OrderedDictionary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!OrderedDictionary commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OrderedDictionary methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aCollection + super = aCollection ifFalse: [^false]. + ^self keys = aCollection keys +! ! + +!OrderedDictionary methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anAssociation at: anInteger + ^self at: anAssociation key index: anInteger put: anAssociation value +! ! + +!OrderedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: key index: anInteger put: anObject + | assoc | + assoc := self associationClass key: key value: anObject. + assoc := table atKey: key put: assoc. + assoc == nil + ifTrue: [ + self incrementTally. + table moveLastTo: anInteger] + ifFalse: [ + assoc value: anObject. + table move: assoc to: anInteger]. + ^anObject +! ! + +!OrderedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bucketClass + ^OrderedHashTable +! ! + +!OrderedDictionary methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +compress + table compressTo: tally +! ! + +!OrderedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + (tally > 10 and: [1.5 * tally < table totalSize]) ifTrue: [self compress]. + super do: [:assoc | aBlock evaluateWith: assoc] +! ! + +!OrderedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +first + ^table first value +! ! + +!OrderedDictionary methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexAtKey: key + ^table indexAtKey: key +! ! + +!OrderedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: anObject + ^table indexOfElement: anObject +! ! + +!OrderedDictionary methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isOrderedDictionary + ^true +! ! + +!OrderedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyCollector + ^OrderedCollection new: self size +! ! + +!OrderedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +last + ^table last value +! ! + +!OrderedDictionary methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: anObject ifAbsent: aBlock + table removeObject: anObject ifAbsent: aBlock. + tally := tally - 1. + ^anObject +! ! + +!OrderedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +reverseDo: aBlock + table valuesReverseDo: aBlock +! ! + +!OrderedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +values + | values | + values := Array new: tally. + self withIndexDo: [:each :i | values at: i put: each]. + ^values +! ! + +!OrderedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withIndexDo: aBlock + | i | + i := 1. + self do: [:each | + aBlock value: each value: i. + i := i + 1] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OrderedDictionary class' category: #Kernel! +OrderedDictionary class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/OrderedHashTable.Class.st b/modules/Kernel/OrderedHashTable.Class.st new file mode 100644 index 00000000..debfd2f0 --- /dev/null +++ b/modules/Kernel/OrderedHashTable.Class.st @@ -0,0 +1,240 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #OrderedHashTable category: #Kernel! +OpenHashTable subclass: #OrderedHashTable + instanceVariableNames: 'values' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!OrderedHashTable commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + | i | + i := super at: index. + i ifNil: [^nil]. + ^values at: i +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index put: anObject + | i element | + i := self basicAt: index. + element := anObject ifNil: [NilToken]. + (i == nil or: [i == self emptySlot]) + ifTrue: [ + values add: element. + super at: index put: values size] + ifFalse: [values at: i put: element]. + ^anObject +! ! + +!OrderedHashTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index tally: tally + | n i count vi | + n := values size. + index * 2 <= n + ifTrue: [ + i := 1. + count := 0. + [ + vi := values at: i. + vi == nil ifFalse: [count := count + 1]. + count = index ifTrue: [^vi == NilToken ifFalse: [vi]]. + i := i + 1. + i <= n] whileTrue] + ifFalse: [ + i := n. + count := tally + 1. + [ + vi := values at: i. + vi == nil ifFalse: [count := count - 1]. + count = index ifTrue: [^vi == NilToken ifFalse: [vi]]. + i := i - 1. + 0 < i] whileTrue] +! ! + +!OrderedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +clearSlot: anInteger with: emptySlot + | i | + i := self basicAt: anInteger. + self basicAt: anInteger put: emptySlot. + values at: i put: emptySlot +! ! + +!OrderedHashTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +compressTo: tally + | relocations compressed | + values size = tally ifTrue: [^self]. + relocations := Array new: values size. + compressed := OrderedCollection new: tally. + values withIndexDo: [:value :index | + value notNil ifTrue: [ + compressed add: value. + relocations at: index put: compressed size]]. + 1 to: self size do: [:index | | old new | + old := super at: index. + old notNil ifTrue: [ + new := relocations at: old. + super at: index put: new]]. + values := compressed +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +elementAt: index + ^values at: index +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +elementsDo: aBlock + values + select: [:value | value !!== nil] + thenDo: [:value | aBlock evaluateWith: (value == NilToken ifFalse: [value])] +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +elementsDo: aBlock count: n + | i | + n = 0 ifTrue: [^self]. + i := 0. + self elementsDo: [:value | + aBlock evaluateWith: value. + i := i + 1. + i = n ifTrue: [^self]] +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +first + values do: [:v | v notNil ifTrue: [^v]]. + ^nil +! ! + +!OrderedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexAtKey: key + | index | + index := self indexOfKey: key. + ^self basicAt: index +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfElement: anObject + | i | + i := 1. + self elementsDo: [:assoc | + assoc value == anObject ifTrue: [^i]. + i := i + 1]. + ^0 +! ! + +!OrderedHashTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + values := OrderedCollection new +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +keysAndValuesDo: aBlock + self elementsDo: [:assoc | aBlock value: assoc key value: assoc value] +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +last + values reverseDo: [:v | v notNil ifTrue: [^v]]. + ^nil +! ! + +!OrderedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +move: anAssociation to: anInteger + | a min max | + a := values indexOf: anAssociation. + min := a min: anInteger. + max := a max: anInteger. + 1 to: self size do: [:i | | index | + index := self basicAt: i. + index notNil ifTrue: [ + (index between: min and: max) ifTrue: [ + index <= a + ifTrue: [self basicAt: i put: index + 1] + ifFalse: [self basicAt: i put: index - 1]]. + index = a ifTrue: [self basicAt: i put: anInteger]]]. + values move: values last to: anInteger +! ! + +!OrderedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +moveLastTo: anInteger + | last | + last := values size. + 1 to: self size do: [:i | | index | + index := self basicAt: i. + index notNil ifTrue: [ + index >= anInteger ifTrue: [self basicAt: i put: index + 1]. + index = last ifTrue: [self basicAt: i put: anInteger]]]. + values move: values last to: anInteger +! ! + +!OrderedHashTable methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +postCopy + super postCopy. + values := values copy +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +privateDo: aBlock + values do: [:value | aBlock evaluateWith: value] +! ! + +!OrderedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeAll + super removeAll. + values removeAll +! ! + +!OrderedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeObject: anObject ifAbsent: aBlock + | association | + association := values + detect: [:assoc | assoc value == anObject] + ifNone: [^aBlock value]. + ^self removeKey: association key ifAbsent: aBlock +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +totalSize + ^values size +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueAt: index ifAbsent: aBlock + | i value | + i := self basicAt: index. + i == nil ifTrue: [^aBlock value]. + i == self emptySlot ifTrue: [^aBlock value]. + value := values at: i ifAbsent: [^aBlock value]. + ^value == NilToken ifFalse: [value] +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +valuesReverseDo: aBlock + values reverseDo: [:assoc | + assoc == nil + ifFalse: [aBlock evaluateWith: (assoc == NilToken ifFalse: [assoc]) value]] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OrderedHashTable class' category: #Kernel! +OrderedHashTable class + instanceVariableNames: ''! + +!OrderedHashTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^(super new: anInteger) initialize +! ! + + +OrderedHashTable initialize! + diff --git a/modules/Kernel/Point.Class.st b/modules/Kernel/Point.Class.st new file mode 100644 index 00000000..23cd373d --- /dev/null +++ b/modules/Kernel/Point.Class.st @@ -0,0 +1,293 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Point category: #Kernel! +Object subclass: #Point + instanceVariableNames: 'x y' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Point commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- operand + | point | + point := operand asPoint. + ^x - point x @ (y - point y) +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +* operand + | point | + point := operand asPoint. + ^x * point x @ (y * point y) +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +/ operand + | point | + point := operand asPoint. + ^x / point x @ (y / point y) +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +// operand + | point | + point := operand asPoint. + ^x // point x @ (y // point y) +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +\\ operand + | point | + point := operand asPoint. + ^x \\ point x @ (y \\ point y) +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ operand + | point | + point := operand asPoint. + ^x + point x @ (y + point y) +! ! + +!Point methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aPoint + ^x < aPoint x and: [y < aPoint y] +! ! + +!Point methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aPoint + ^x <= aPoint x and: [y <= aPoint y] +! ! + +!Point methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aPoint + ^aPoint isPoint and: [x = aPoint x] and: [y = aPoint y] +! ! + +!Point methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aPoint + ^x > aPoint x and: [self y > aPoint y] +! ! + +!Point methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aPoint + ^x >= aPoint x and: [y >= aPoint y] +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +abs + ^x abs @ y abs +! ! + +!Point methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +asPoint + ^self +! ! + +!Point methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +between: aPoint and: anotherPoint + ^aPoint <= self and: [self <= anotherPoint] +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +corner: aPoint + ^Rectangle origin: self corner: aPoint +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +down: aNumber + ^x @ (y + aNumber) +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +extent: aPoint + ^Rectangle origin: self extent: aPoint +! ! + +!Point methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^x hashWith: y +! ! + +!Point methodsFor: 'geometry - testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBefore: aPoint + ^y < aPoint y or: [aPoint y = y and: [x < aPoint x]] +! ! + +!Point methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isPoint + ^true +! ! + +!Point methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +left: aNumber + ^x - aNumber @ y +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftAndDown: delta + | point | + point := delta asPoint. + ^x - point x @ (y + point y) +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftAndUp: delta + | point | + point := delta asPoint. + ^x - point x @ (y - point y) +! ! + +!Point methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +max: aPoint + ^(x max: aPoint x) @ (y max: aPoint y) +! ! + +!Point methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +min: aPoint + | max | + max := aPoint asPoint. + ^(x min: max x) @ (y min: max y) +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +moveBy: aPoint + x := x + aPoint x. + y := y + aPoint y +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +negated + ^x negated @ y negated +! ! + +!Point methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + x isFraction + ifTrue: [ + aStream nextPut: $(. + x printOn: aStream. + aStream nextPut: $)] + ifFalse: [x printOn: aStream]. + aStream nextPutAll: ' @ '. + y isFraction + ifTrue: [ + aStream nextPut: $(. + y printOn: aStream. + aStream nextPut: $)] + ifFalse: [y printOn: aStream] +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +right: aNumber + ^x + aNumber @ y +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightAndUp: delta + | point | + point := delta asPoint. + ^x + point x @ (y - point y) +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightBottom: aPoint + ^self corner: aPoint +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightTop: aPoint + ^Rectangle leftBottom: self rightTop: aPoint +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +rounded + ^x rounded @ y rounded +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +translatedBy: delta + ^self + delta +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +transpose + ^y @ x +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncated + ^x truncated @ y truncated +! ! + +!Point methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncateTo: factor + ^(self x truncateTo: factor) @ (self y truncateTo: factor) +! ! + +!Point methodsFor: 'geometry' stamp: 'KenD 28/Jun/2026 13:27:38'! +up: aNumber + ^x @ (y - aNumber) +! ! + +!Point methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +x + ^x +! ! + +!Point methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +x: aNumber + x := aNumber +! ! + +!Point methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +x: abscissa y: ordinate + x := abscissa. + y := ordinate +! ! + +!Point methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +y + ^y +! ! + +!Point methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +y: aNumber + y := aNumber +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Point class' category: #Kernel! +Point class + instanceVariableNames: ''! + +!Point class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString + ^self readFrom: aString readStream +! ! + +!Point class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +readFrom: aStream + " + Point readFrom: '1 @ 2' readStream + " + | x y | + aStream skipSeparators. + x := Integer readFrom: aStream. + aStream skipTo: $@; skipSeparators. + y := Integer readFrom: aStream. + ^x @ y +! ! + +!Point class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +x: x y: y + ^self new x: x; y: y +! ! + + diff --git a/modules/Kernel/Process.Class.st b/modules/Kernel/Process.Class.st new file mode 100644 index 00000000..26428c9a --- /dev/null +++ b/modules/Kernel/Process.Class.st @@ -0,0 +1,156 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Process category: #Kernel! +Object subclass: #Process + instanceVariableNames: 'name nativeStack topContext protectedFrames exceptionHandler semaphore hopping' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Process commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. + + Processes are the base of concurrency in Egg. For simplicity they are currently designed without + support parallel execution (this is something we are very open to discuss in the future). + For the same reason, they are also designed without preemption support. This means processes + assume they will run until they suspend themselves (i.e. because of an unhandled exception), + because they go to sleep waiting in a Semaphore, or because they voluntarily yield. + + Processes dynamically change their class when switching state, from SuspendedProcess to ActiveProcess + and viceversa. + They can also be in two modes when suspended: reified or native. When reified the process' topContext + points to its current stack frame, which forms a linked list down to its initial frame. In that case, + the nativeStack is ignored (even by GC). If the process has no topContext, it means is nativeStack + contains all of its frames in a format optimized for execution. +! + +!Process methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +beActive + self notAllowed +! ! + +!Process methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +beInactive + self notAllowed +! ! + +!Process methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +launch: aMessage + self notAllowed +! ! + +!Process methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +drop + self subclassResponsibility +! ! + +!Process methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluating: aMessageSend + self notAllowed +! ! + +!Process methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +exceptionHandler + ^exceptionHandler +! ! + +!Process methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + name := 'nameless process'. + protectedFrames := OrderedCollection new: 20 +! ! + +!Process methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +findHandlerFor: anException + | original result | + original := exceptionHandler ifNil: [^nil]. + exceptionHandler := nil. + result := original findHandlerFor: anException. + exceptionHandler := original. + ^result +! ! + +!Process methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeStack + nativeStack := ProcessVMStack on: self +! ! + +!Process methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isActive + ^false +! ! + +!Process methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +isReified + ^topContext notNil +! ! + +!Process methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isScheduled + ^Processor isScheduled: self +! ! + +!Process methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name + ^name +! ! + +!Process methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name: aString + name := aString +! ! + +!Process methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nativeStack + nativeStack ifNil: [self initializeStack]. + ^nativeStack +! ! + +!Process methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +notAllowed + self error: 'this message cannot be executed in current process state' +! ! + +!Process methodsFor: 'scheduling' stamp: 'KenD 28/Jun/2026 13:27:38'! +takeControl + self notAllowed +! ! + +!Process methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +topContext + ^topContext +! ! + +!Process methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +topContext: aContext + topContext := aContext +! ! + +!Process methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +snapshot + self notAllowed +! ! + +!Process methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +wantsToStepInto + | answer | + answer := hopping. + answer ifTrue: [hopping := false]. + ^answer +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Process class' category: #Kernel! +Process class + instanceVariableNames: ''! + +!Process class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +sending: aSymbol to: anObject with: arguments + ^SuspendedProcess sending: aSymbol to: anObject with: arguments +! ! + + +Process initialize! + diff --git a/modules/Kernel/ProcessStack.Class.st b/modules/Kernel/ProcessStack.Class.st new file mode 100644 index 00000000..87799a9f --- /dev/null +++ b/modules/Kernel/ProcessStack.Class.st @@ -0,0 +1,71 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ProcessStack category: #Kernel! +Object subclass: #ProcessStack + instanceVariableNames: 'process sp bp env' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ProcessStack commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!ProcessStack methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +lastArgumentOf: frame + " + Given the base index of a frame, then comes retaddr, then last argument passed in the invokation + " + ^self at: frame + 2 +! ! + +!ProcessStack methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +contextSwitchTo: next + self subclassResponsibility +! ! + +!ProcessStack methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +fillFrom: aContext + #CRITICAL. + sp := aContext copyAllTo: self. + env := aContext lastEnvironment +! ! + +!ProcessStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +env + ^env +! ! + +!ProcessStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +env: anObject + env := anObject +! ! + +!ProcessStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +process + ^process +! ! + +!ProcessStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +process: aProcess + process := aProcess +! ! + +!ProcessStack methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +snapshot + self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ProcessStack class' category: #Kernel! +ProcessStack class + instanceVariableNames: ''! + +!ProcessStack class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aProcess + ^self errorVMSpecific +! ! + + diff --git a/modules/Kernel/ProcessStackChunk.Class.st b/modules/Kernel/ProcessStackChunk.Class.st new file mode 100644 index 00000000..fbb20eb4 --- /dev/null +++ b/modules/Kernel/ProcessStackChunk.Class.st @@ -0,0 +1,101 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ProcessStackChunk category: #Kernel! +Object subclass: #ProcessStackChunk + instanceVariableNames: 'sp bp base prev defaultReturn' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ProcessStackChunk commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +base + ^base +! ! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +base: anInteger + base := anInteger +! ! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bp + ^bp +! ! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bp: anInteger + bp := anInteger +! ! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultReturn + ^defaultReturn +! ! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultReturn: anInteger + defaultReturn := anInteger +! ! + +!ProcessStackChunk methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + defaultReturn := 0 +! ! + +!ProcessStackChunk methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +invalidate + sp := bp := nil +! ! + +!ProcessStackChunk methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +isForCallback + ^prev notNil +! ! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prev + ^prev +! ! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prev: aProcessStackChunk + prev := aProcessStackChunk +! ! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +relocate: anInteger + sp ifNotNil: [ + sp := sp + anInteger. + bp := bp + anInteger]. + base := base + anInteger +! ! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sp + ^sp +! ! + +!ProcessStackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sp: anInteger + sp := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ProcessStackChunk class' category: #Kernel! +ProcessStackChunk class + instanceVariableNames: ''! + +!ProcessStackChunk class methodsFor: 'instance-creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +after: aProcessStackChunk + ^self new prev: aProcessStackChunk +! ! + + +ProcessStackChunk initialize! + diff --git a/modules/Kernel/ProcessVMStack.Class.st b/modules/Kernel/ProcessVMStack.Class.st new file mode 100644 index 00000000..da39d622 --- /dev/null +++ b/modules/Kernel/ProcessVMStack.Class.st @@ -0,0 +1,99 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ProcessVMStack category: #Kernel! +ProcessStack subclass: #ProcessVMStack + instanceVariableNames: 'buffer bufferSize' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ProcessVMStack commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!ProcessVMStack methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger + +! ! + +!ProcessVMStack methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: anObject + +! ! + +!ProcessVMStack methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeWithNewBuffer + +! ! + +!ProcessVMStack methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeWithActiveBuffer + +! ! + +!ProcessVMStack methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +bp + +! ! + +!ProcessVMStack methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +bpAt: anInteger + +! ! + +!ProcessVMStack methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +bpAt: anInteger put: anotherInteger + +! ! + +!ProcessVMStack methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +bufferSize + +! ! + +!ProcessVMStack methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +contextSwitchTo: aProcessStack + +! ! + +!ProcessVMStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +process: aProcess + super process: aProcess. + aProcess isActive + ifTrue: [self initializeWithActiveBuffer] + ifFalse: [self initializeWithNewBuffer] +! ! + +!ProcessVMStack methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +pcAt: anInteger + +! ! + +!ProcessVMStack methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +pcAt: anInteger put: anotherInteger of: code + +! ! + +!ProcessVMStack methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +snapshot + +! ! + +!ProcessVMStack methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +sp: anInteger + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ProcessVMStack class' category: #Kernel! +ProcessVMStack class + instanceVariableNames: ''! + +!ProcessVMStack class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aProcess + ^self new process: aProcess +! ! + + diff --git a/modules/Kernel/ProcessorScheduler.Class.st b/modules/Kernel/ProcessorScheduler.Class.st new file mode 100644 index 00000000..7d6c93d3 --- /dev/null +++ b/modules/Kernel/ProcessorScheduler.Class.st @@ -0,0 +1,108 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ProcessorScheduler category: #Kernel! +Object subclass: #ProcessorScheduler + instanceVariableNames: 'activeProcess queues dropHandler interruptsEnabled' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ProcessorScheduler commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ProcessorScheduler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +activeProcess + ^activeProcess +! ! + +!ProcessorScheduler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +activeProcess: anActiveProcess + activeProcess := anActiveProcess +! ! + +!ProcessorScheduler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +areInterruptsEnabled + ^interruptsEnabled +! ! + +!ProcessorScheduler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +dropHandler: aClosure + dropHandler := aClosure +! ! + +!ProcessorScheduler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +dropActive + | process | + self enableInterrupts: false. + self dropping: activeProcess. + process := self nextReadyProcess ifNil: [self idle]. + process takeControl +! ! + +!ProcessorScheduler methodsFor: 'events' stamp: 'KenD 28/Jun/2026 13:27:38'! +dropping: aProcess + ^dropHandler value: aProcess +! ! + +!ProcessorScheduler methodsFor: 'priorities' stamp: 'KenD 28/Jun/2026 13:27:38'! +enableInterrupts: aBoolean + " + Interrupt checks happen periodically, and in case interrupts are + enabled the system might trigger UI updates or rescue ephemerons + " + | prev | + prev := interruptsEnabled. + interruptsEnabled := aBoolean. + ^prev +! ! + +!ProcessorScheduler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +idle + "when there's absolutely nothing to do, just try to tell the host we are doomed" + self _halt +! ! + +!ProcessorScheduler methodsFor: 'priorities' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + interruptsEnabled := false. + activeProcess := ActiveProcess new name: 'main process'. + dropHandler := [:process | ] +! ! + +!ProcessorScheduler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextReadyProcess + queues + reverseDo: [:queue | queue isEmpty ifFalse: [^queue removeFirst]]. + ^nil +! ! + +!ProcessorScheduler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +schedule: aProcess + | process | + prev := self enableInterrupts: false. + queue := scheduledProcesses at: aProcess priority. + queue add: aProcess. + prev ifTrue: [self enableInterrupts: true] +! ! + +!ProcessorScheduler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +unschedule: aProcess + | queue prev | + prev := self enableInterrupts: false. + self dropping: aProcess. + queue := queues at: aProcess priority. + queue remove: aProcess ifAbsent: nil. + prev ifTrue: [self enableInterrupts: true] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ProcessorScheduler class' category: #Kernel! +ProcessorScheduler class + instanceVariableNames: ''! + + +ProcessorScheduler initialize! + diff --git a/modules/Kernel/ProtoObject.Class.st b/modules/Kernel/ProtoObject.Class.st new file mode 100644 index 00000000..72dba39d --- /dev/null +++ b/modules/Kernel/ProtoObject.Class.st @@ -0,0 +1,450 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ProtoObject category: #Kernel! +nil subclass: #ProtoObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ProtoObject commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ProtoObject methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +!!== anObject + ^self == anObject ifTrue: [false] ifFalse: [true] +! ! + +!ProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_basicAt: anInteger + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beSpecial + #UnderBeSpecial. "hack to avoid missing symbol error during bootstrap" + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_copyBasicHeaderFrom: other + self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_copyHeaderSized: byteSize from: anObject + self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_doesNotUnderstand: selector with: arguments + " + Only the VM sends this. To adapt a message send with arguments in the + stack onto a Message object with a selector and an array of arguments + " + | message result | + message := Message selector: selector arguments: arguments. + result := self doesNotUnderstand: message. + ^result _returnPoppingArguments: 2 +! ! + +!ProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_hash + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isBytes + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_pointersSize + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_size + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'raw access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_uLongAtOffset: offset + ^self _primitiveULongAtOffset: offset +! ! + +!ProtoObject methodsFor: 'raw access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_uLongAtValidOffset: offset put: anInteger + self _primitiveULongAtOffset: offset put: anInteger. + ^anInteger +! ! + +!ProtoObject methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +~~ anObject + ^self == anObject ifTrue: [false] ifFalse: [true] +! ! + +!ProtoObject methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += other + ^self == other +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +== anObject + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +allReferences + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger + ^self primitiveAt: anInteger +! ! + +!ProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger put: anObject + ^self primitiveAt: anInteger put: anObject +! ! + +!ProtoObject methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicByteAt: index + index _isSmallInteger ifFalse: [^self outOfBoundsIndex: index]. + (1 <= index and: [index <= self _size]) + ifFalse: [self outOfBoundsIndex: index]. + ^self byteAtValid: index +! ! + +!ProtoObject methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicByteAt: index put: value + index _isSmallInteger ifFalse: [^self outOfBoundsIndex: index]. + (1 <= index and: [index <= self _size]) + ifFalse: [self outOfBoundsIndex: index]. + value _isSmallInteger + ifFalse: [^self error: 'value does not fit in a byte']. + (0 <= value and: [value < 256]) + ifFalse: [^self error: 'value does not fit in a byte']. + ^self byteAtValid: index put: value +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicHash + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicHash: anInteger + self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicInstVarAt: index + index _isSmallInteger ifFalse: [^self outOfBoundsIndex: index]. + (1 <= index and: [index <= self _size]) ifFalse: [^self outOfBoundsIndex: index]. + ^self _isBytes ifTrue: [self _byteAt: index] ifFalse: [self objectAtValid: index] +! ! + +!ProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicInstVarAt: index put: anObject + index _isSmallInteger ifFalse: [^self outOfBoundsIndex: index]. + (1 <= index and: [index <= self _size]) ifFalse: [self outOfBoundsIndex: index]. + ^self _isBytes + ifTrue: [self byteAtValid: index put: anObject] + ifFalse: [self objectAtValid: index put: anObject] +! ! + +!ProtoObject methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicObjectAt: grossIndex + | index | + index := self basicObjectIndexOf: grossIndex. + ^self _basicAt: index +! ! + +!ProtoObject methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicObjectAt: grossIndex put: anObject + | index | + index := self basicObjectIndexOf: grossIndex. + ^self objectAtValid: index put: anObject +! ! + +!ProtoObject methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicObjectIndexOf: grossIndex + | instVars index | + grossIndex _isSmallInteger ifFalse: [^self outOfBoundsIndex: grossIndex]. + instVars := (self _hasNamedSlots and: [self _isArrayed]) + ifTrue: [self class instSize] + ifFalse: [0]. + (1 <= grossIndex and: [grossIndex <= (self _size - instVars)]) + ifFalse: [^self outOfBoundsIndex: grossIndex]. + index := grossIndex + instVars. + ^index +! ! + +!ProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicSize + ^self primitiveSize +! ! + +!ProtoObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +become: anotherObject + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'meta accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +behavior + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'meta accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +behavior: aBehavior + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +class + ^self behavior classBinding +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +doesNotUnderstand: aMessage + ^MessageNotUnderstood message: aMessage receiver: self +! ! + +!ProtoObject methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +error: aString + ^Error signal: aString +! ! + +!ProtoObject methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +errorVMSpecific + ^self error: 'this method should have been overriden by the current VM' +! ! + +!ProtoObject methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:38'! +finalizationRegistry + ^Kernel finalizer +! ! + +!ProtoObject methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:38'! +finalize + +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +halt + Halt signal +! ! + +!ProtoObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^self basicHash +! ! + +!ProtoObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasIndexedSlots + ^self class _instancesAreArrayed +! ! + +!ProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +_holdRefererIfNeeded: referent + +! ! + +!ProtoObject methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +identityHash + ^self basicHash +! ! + +!ProtoObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifNil: aBlock + ^self +! ! + +!ProtoObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifNotNil: aBlock + ^aBlock argumentCount = 1 + ifTrue: [aBlock evaluateWith: self] + ifFalse: [aBlock evaluate] +! ! + +!ProtoObject methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:38'! +ignoreFinalization + self finalizationRegistry remove: self ifAbsent: nil +! ! + +!ProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeExtended: aBoolean contentSize: size + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +instVarAt: i + self _isSmallInteger ifTrue: [^self shouldNotImplement]. + ^self _isBytes + ifTrue: [self basicByteAt: i] + ifFalse: [self basicInstVarAt: i] +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +instVarAt: i put: anObject + self _isSmallInteger ifTrue: [^self shouldNotImplement]. + ^self _isBytes + ifTrue: [self basicByteAt: i put: anObject] + ifFalse: [self basicInstVarAt: i put: anObject] +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +isNil + ^false +! ! + +!ProtoObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSmallInteger + ^false +! ! + +!ProtoObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +literalString + ^nil +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +notNil + ^true +! ! + +!ProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +objectAtValid: index + ^self _basicAt: index +! ! + +!ProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +objectAtValid: index put: anObject + anObject _holdRefererIfNeeded: self. + ^self _basicAt: index put: anObject +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +perform: aSymbol + ^self perform: aSymbol withArguments: #() +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +perform: aSymbol with: anObject + ^self perform: aSymbol withArguments: {anObject} +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +perform: aSymbol withArguments: anArray + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveAt: i + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveAt: i put: anObject + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveSize + ^self errorVMSpecific +! ! + +!ProtoObject methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + | string article | + string := self class name. + article := string first isVowel ifTrue: ['an '] ifFalse: ['a ']. + aStream nextPutAll: article; nextPutAll: string +! ! + +!ProtoObject methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printString + | stream | + stream := '' writeStream. + self printOn: stream. + ^stream contents +! ! + +!ProtoObject methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:38'! +requireFinalization + self finalizationRegistry add: self +! ! + +!ProtoObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +requiresFinalization + ^self finalizationRegistry includes: self +! ! + +!ProtoObject methodsFor: 'interrupts' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalStep + Processor activeProcess handleStepSignal +! ! + +!ProtoObject methodsFor: 'interrupts' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalStep: aSymbol + Processor activeProcess handleStepSignal +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +yourself + ^self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ProtoObject class' category: #Kernel! +ProtoObject class + instanceVariableNames: ''! + +!ProtoObject class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeBitMasks + " + self initializeBitMasks + " + self addNamespaceAs: #ObjectBitsMasks. + ObjectBitsMasks + at: #IsBytes put: 16r1; + at: #IsArrayed put: 16r2; + at: #IsNamed put: 16r4; + at: #IsRemembered put: 16r8; + at: #IsSpecial put: 16r10; + at: #Bit1 put: 16r20; + at: #IsSecondGeneration put: 16r40; + at: #IsSmall put: 16r80; + at: #HasBeenSeen put: 16r20. + ObjectBitsMasks keys + do: [:key | ObjectBitsMasks + at: key , 'Mask' + put: 16rFF - (ObjectBitsMasks at: key)] +! ! + +!ProtoObject class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeConstants + " + ProtoObject initializeConstants + " + self addNamespaceAs: #ObjectFieldsOffset. + ObjectFieldsOffset + at: #_Behavior put: 0; + at: #_Reserved put: -2; + at: #_ExtendedSize put: -3; + at: #_Flags put: -5; + at: #_SmallSize put: -6; + at: #_Hash put: -8 +! ! + +!ProtoObject class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self basicNew initialize +! ! + + diff --git a/modules/Kernel/ReadStream.Class.st b/modules/Kernel/ReadStream.Class.st new file mode 100644 index 00000000..4fb09a19 --- /dev/null +++ b/modules/Kernel/ReadStream.Class.st @@ -0,0 +1,625 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ReadStream category: #Kernel! +Stream subclass: #ReadStream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ReadStream commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ReadStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +alignTo: boundary + | n | + n := boundary - (self position \\ boundary) \\ boundary. + self skip: n +! ! + +!ReadStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atBeginning + ^self position = 0 +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +back + self skip: -1 +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +backToAny: aCollection + " + 'Smalltalk' readStream position: 'Smallta' size; backToAny: 'ml' + " + [self position = 0] whileFalse: [| token | + token := self prev. + (aCollection includes: token) ifTrue: [^self]] +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +backToOpen: open + " + '--|things||some|-}blah' readStream next: '--|things||some' size; backToOpen: $|; yourself + " + | start | + start := self position. + [self position > 0] whileTrue: [ + self prev = open ifTrue: [ + self position = 0 ifTrue: [^self]. + self prev = open ifFalse: [^self next; yourself]]]. + self position: start +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +backToOpen: close with: open + " + '-{things{some}-}blah' readStream position: '-{things{some}-}' size - 1; backToOpen: ${ with: $} + " + | start tokens count | + open = close ifTrue: [^self backToOpen: close]. + start := self position. + tokens := {open. close}. + count := -1. + [self position = 0 or: [count = 0]] whileFalse: [| token | + self backToAny: tokens. + token := self peek. + token = open ifTrue: [count := count + 1]. + token = close ifTrue: [count := count - 1]]. + count = 0 ifFalse: [self position: start] +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNextChunk + | token bulk | + token := self isBinary ifTrue: [$!! asInteger] ifFalse: [$!!]. + bulk := self upTo: token. + [self atEnd orNot: [self peekFor: token]] whileFalse: [ + bulk := bulk copyWith: token. + bulk := bulk , (self upTo: token)]. + ^bulk +! ! + +!ReadStream methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +binaryReadStream + self isBinary ifTrue: [^self]. + ^self copy beBinary +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +collectionTailOf: anInteger + | start tail first | + start := self size - anInteger + 1 max: 1. + tail := self copyFrom: start to: self size. + first := tail findFirst: [:byte | byte < 128] ifAbsent: 1. + first > 1 ifTrue: [ + start := start + first - 1. + tail := tail allButFirst: first - 1]. + ^UTF8 decode: tail +! ! + +!ReadStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +collectorOfSize: anInteger + ^self subclassResponsibility +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyFrom: start to: stop + | pos result | + pos := self position. + self position: start - 1. + result := self next: stop - start + 1. + self position: pos. + ^result +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +countBlanks + | count tab space | + count := 0. + tab := Character tab. + space := $ . + [self atEnd] whileFalse: [| char | + char := self next. + char = space ifTrue: [count := count + 1] ifFalse: [ + char = tab ifTrue: [count := count + 4] ifFalse: [ + self skip: -1. + ^count]]]. + ^count +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +getBytesFor: aByteArray + self readInto: aByteArray from: 1 to: aByteArray sizeInBytes +! ! + +!ReadStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +getInteger + | byte | + byte := self nextByte. + ^128 <= byte ifTrue: [self getInteger * 128 + byte - 128] ifFalse: [byte] +! ! + +!ReadStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBinary + ^false +! ! + +!ReadStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmpty + ^self size = 0 +! ! + +!ReadStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +newCollector + ^self collectorOfSize: 0 +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +next + self subclassResponsibility +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +next: anInteger + self subclassResponsibility +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextByte + ^self next asInteger +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextChunk + | bulk index n m bytes cr chunk | + bulk := self basicNextChunk. + index := 1. + n := bulk size. + [ + index <= n and: [| cp | + cp := bulk byteAt: index. + cp <= 32]] + whileTrue: [index := index + 1]. + m := n - index + 1. + m = 0 ifTrue: [^'']. + bytes := ByteArray new: m. + bytes replaceFrom: 1 to: m with: bulk startingAt: index. + cr := self eol includes: Cr. + 1 to: m do: [:i | | byte | + byte := bytes at: i. + (byte > 127 or: [byte = 10]) ifTrue: [ + chunk := UTF8 current decode: bytes. + ^cr + ifTrue: [chunk copyWithout: Lf] + ifFalse: [chunk replaceAll: self eol with: String cr]]]. + chunk := bytes asString. + ^self eol = String cr + ifTrue: [chunk] + ifFalse: [chunk replaceAll: self eol with: String cr] +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextFloat + | float | + float := Float new. + self getBytesFor: float. + ^float +! ! + +!ReadStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextInteger + ^Integer readFrom: self +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextLine + | delimiter line | + delimiter := self lineDelimiter. + line := self upTo: delimiter. + delimiter = Cr ifTrue: [self peekFor: Lf]. + ^line +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextLong + | bytes | + bytes := ByteArray new: 4. + self getBytesFor: bytes. + ^bytes longAtOffset: 0 +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextNoFail: anInteger + | n | + n := anInteger min: self size - self position. + ^self next: n +! ! + +!ReadStream methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextString + | size | + size := self nextULong. + ^(self next: size) asString +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextSubstring + | start | + [ + self atEnd ifTrue: [^'']. + self next isAlphaNumericOrUnderscore] whileFalse. + start := self position. + [self atEnd not and: [self peek isAlphaNumericOrUnderscore]] + whileTrue: [self next]. + ^self copyFrom: start to: self position +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextSubstringOrNumber + | c numeric token writer | + [ + self atEnd ifTrue: [^'']. + c := self next. + c isAlphanumeric] whileFalse. + numeric := c isDigit. + writer := self newCollector writeStream. + writer nextPut: c. + [ + self atEnd not and: [ + c := self next. + numeric ifTrue: [c isDigit] ifFalse: [c isAlphanumeric]]] + whileTrue: [writer nextPut: c]. + token := writer contents. + (numeric and: [c isLetter]) ifTrue: [self skip: -1]. + ^token first isDigit ifTrue: [token asInteger] ifFalse: [token] +! ! + +!ReadStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextULong + | a0 a1 a2 a3 | + a0 := self nextByte. + a1 := self nextByte bitShift: 8. + a2 := self nextByte bitShift: 16. + a3 := self nextByte bitShift: 24. + ^a3 + a2 + a1 + a0 +! ! + +!ReadStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextUShort + | a0 a1 | + a0 := self nextByte. + a1 := self nextByte bitShift: 8. + ^a1 + a0 +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextUTF8 + ^Character value: self nextUTF8Code +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextUTF8Code + ^UTF8 current decodeFrom: self +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextUTF8Line + self position = 0 ifTrue: [self peekForAll: UTF8 prefix asString]. + ^UTF8 decode: self nextLine asByteArray +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextWhile: aBlock + | write | + write := self newCollector writeStream. + [self atEnd not and: [aBlock evaluateWith: self peek]] + whileTrue: [write nextPut: self next]. + ^write contents +! ! + +!ReadStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +notEmpty + ^self isEmpty not +! ! + +!ReadStream methodsFor: 'peeking' stamp: 'KenD 28/Jun/2026 13:27:38'! +peek + self shouldNotImplement +! ! + +!ReadStream methodsFor: 'peeking' stamp: 'KenD 28/Jun/2026 13:27:38'! +peek: n + | pos safe data | + pos := self position. + safe := n min: self sizeToEnd. + data := self next: safe. + self position: pos. + ^data +! ! + +!ReadStream methodsFor: 'peeking' stamp: 'KenD 28/Jun/2026 13:27:38'! +peekFor: token + | found | + found := self peek = token. + found ifTrue: [self skip]. + ^found +! ! + +!ReadStream methodsFor: 'peeking' stamp: 'KenD 28/Jun/2026 13:27:38'! +peekForAll: aCollection + | n found | + n := aCollection size. + found := (self peek: n) equalsTo: aCollection. + found ifTrue: [self skip: n]. + ^found +! ! + +!ReadStream methodsFor: 'reverse reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +prev + ^self position > 0 + ifTrue: [self position: self position - 1; peek] + ifFalse: [self error: 'read beyond start of stream'] +! ! + +!ReadStream methodsFor: 'reverse reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +prevChunk + | bulk token index n m bytes chunk | + token := self isBinary ifTrue: [$!! asInteger] ifFalse: [$!!]. + bulk := self reverseUpTo: token. + [self atBeginning orNot: [self reversePeekFor: token]] + whileFalse: [bulk := (self reverseUpTo: token) , '!!' , bulk]. + index := 1. + n := bulk size. + [ + index <= n and: [| char | + char := bulk at: index. + char asInteger <= 32]] + whileTrue: [index := index + 1]. + m := n - index + 1. + m = 0 ifTrue: [^'']. + bytes := ByteArray new: m. + bytes isEmpty ifTrue: [^'']. + bytes replaceFrom: 1 to: m with: bulk startingAt: index. + chunk := UTF8 current decode: bytes. + ^chunk copyWithout: Lf +! ! + +!ReadStream methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +readingError + EndOfStream signal +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +readInto: aByteArray from: start to: stop + | data | + data := self next: stop - start + 1. + aByteArray replaceBytesFrom: start to: stop with: data startingAt: 1 +! ! + +!ReadStream methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +readStream + ^self +! ! + +!ReadStream methodsFor: 'reverse reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +reversePeekFor: token + | prev | + self atBeginning ifTrue: [^false]. + prev := self prev. + token = prev ifTrue: [^true]. + self position: self position + 1. + ^false +! ! + +!ReadStream methodsFor: 'reverse reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +reverseSkipTo: token + [self atBeginning] whileFalse: [self prev = token ifTrue: [^true]]. + ^false +! ! + +!ReadStream methodsFor: 'reverse reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +reverseUpTo: token + | offset pos found | + pos := self position. + found := self reverseSkipTo: token. + offset := found ifTrue: [1] ifFalse: [0]. + ^self copyFrom: self position + offset + 1 to: pos +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +skipLine + | delimiter found | + delimiter := self lineDelimiter. + found := self skipTo: delimiter. + delimiter = Cr ifTrue: [self peekFor: Lf]. + ^found +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +skipSeparators + [self atEnd] whileFalse: [ + self peek isBlank ifFalse: [^self]. + self next] +! ! + +!ReadStream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +skipTo: token + [self atEnd] whileFalse: [self next = token ifTrue: [^true]]. + ^false +! ! + +!ReadStream methodsFor: 'wb' stamp: 'KenD 28/Jun/2026 13:27:38'! +skipWhitespace + [self atEnd orNot: [self peek isBlank]] whileFalse: [self next] +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +throughAll: aCollection + " + (InternalReadStream on: 'Smalltalk') throughAll: 'll' + " + | collection pos | + pos := self position. + collection := self upToAll: aCollection. + ^self atEnd + ifTrue: [self position: pos; upToEnd] + ifFalse: [collection , aCollection] +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +untilAnySatisfying: aBlock + | write | + write := self newCollector writeStream. + [self atEnd or: [aBlock evaluateWith: self peek]] + whileFalse: [write nextPut: self next]. + ^write contents +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upTo: token + | write c | + write := self newCollector writeStream. + [ + self atEnd not and: [ + c := self next. + c ~= token]] + whileTrue: [write nextPut: c]. + ^write contents +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToAll: aCollection + " + (InternalReadStream on: 'Smalltalk') upToAll: 'al' + " + | pattern result next aux | + pattern := InternalReadStream on: aCollection. + result := InternalWriteStream on: self newCollector. + aux := InternalWriteStream on: self newCollector. + [self atEnd or: [pattern atEnd]] whileFalse: [ + next := self next. + next = pattern next ifTrue: [aux nextPut: next] ifFalse: [ + self position: self position - aux size. + result nextPutAll: aux contents; nextPut: next. + pattern reset. + aux reset]]. + ^result contents +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToAny: aCollection + | write c | + write := self newCollector writeStream. + [ + self atEnd not and: [ + c := self next. + (aCollection includes: c) not]] + whileTrue: [write nextPut: c]. + ^write contents +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToAnySatisfying: aBlock + | write c | + write := self newCollector writeStream. + [ + self atEnd not and: [ + c := self next. + (aBlock evaluateWith: c) not]] + whileTrue: [write nextPut: c]. + ^write contents +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToClosing: open + " + '|things||some|-}blah' readStream next; upToClosing: $| + " + | start end result opens | + start := self position. + [ + self upTo: open. + self prev = open ifFalse: [ + self position: start. + ^nil]. + self skip: 1. + opens := self peek = open. + opens ifTrue: [self next]. + opens] whileTrue. + end := self position. + self position: start. + result := self next: end - start - 1. + self skip: 1. + ^result +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToClosing: open with: close + " + '{things{some}-}blah' readStream next; upToClosing: ${ with: $}; next + " + | start tokens count pos collection | + open = close ifTrue: [^self upToClosing: open]. + start := self position. + tokens := {open. close}. + count := 1. + [self atEnd or: [count = 0]] whileFalse: [| token | + self upToAny: tokens. + token := self skip: -1; next. + pos := self position. + token = open ifTrue: [count := count + 1]. + token = close ifTrue: [count := count - 1]]. + count = 0 ifFalse: [ + self position: start. + ^nil]. + self position: start. + collection := self next: pos - 1 - start. + self skip: 1. + ^collection +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToEnd + ^self next: self sizeToEnd +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToLast: token + " + '{things{some}-}blah' readStream next; upToLast: $} + " + | start pos collection | + start := self position. + [self atEnd] whileFalse: [ + self upTo: token. + (self skip: -1; next) = token ifTrue: [pos := self position]]. + self position: start. + pos isNil ifTrue: [^self upToEnd]. + collection := self next: pos - start - 1. + self skip: 1. + ^collection +! ! + +!ReadStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToWhitespace + ^self upToAnySatisfying: [:c | c isBlank] +! ! + +!ReadStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf8Trailing: byte + (byte bitAnd: 2r11100000) = 2r11000000 ifTrue: [^1]. + (byte bitAnd: 2r11110000) = 2r11100000 ifTrue: [^2]. + (byte bitAnd: 2r11111000) = 2r11110000 ifTrue: [^3]. + ^nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ReadStream class' category: #Kernel! +ReadStream class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/ReadWriteStream.Class.st b/modules/Kernel/ReadWriteStream.Class.st new file mode 100644 index 00000000..57acf7ef --- /dev/null +++ b/modules/Kernel/ReadWriteStream.Class.st @@ -0,0 +1,243 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ReadWriteStream category: #Kernel! +InternalWriteStream subclass: #ReadWriteStream + instanceVariableNames: 'reader' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ReadWriteStream commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ReadWriteStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atEnd + ^size <= position +! ! + +!ReadWriteStream methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:38'! +beWide + | pos delimiter | + self isWide ifTrue: [^self]. + super beWide. + pos := reader position. + delimiter := reader eol asWideString. + reader := InternalReadStream on: contents. + reader eol: delimiter; position: pos +! ! + +!ReadWriteStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyFrom: start to: stop + | result | + result := reader copyFrom: start to: stop. + reader position: position. + ^result +! ! + +!ReadWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +doReading: aBlock + | next | + reader position: position. + next := aBlock value. + position := reader position. + ^next +! ! + +!ReadWriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +getInteger + ^self doReading: [reader getInteger] +! ! + +!ReadWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +grow: extra + super grow: extra. + reader on: contents; position: position +! ! + +!ReadWriteStream methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + reader := InternalReadStream on: contents. + size := contents size +! ! + +!ReadWriteStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +next + ^self doReading: [reader next] +! ! + +!ReadWriteStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +next: anInteger + ^self doReading: [reader next: anInteger] +! ! + +!ReadWriteStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextByte + ^self doReading: [reader nextByte] +! ! + +!ReadWriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextBytePut: byte + | b | + b := super nextBytePut: byte. + size < position ifTrue: [size := position]. + ^b +! ! + +!ReadWriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextInteger + ^self doReading: [reader nextInteger] +! ! + +!ReadWriteStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextLine + ^self doReading: [reader nextLine] +! ! + +!ReadWriteStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextNoFail: anInteger + ^self doReading: [reader nextNoFail: anInteger] +! ! + +!ReadWriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextPut: token + | t | + t := super nextPut: token. + size < position ifTrue: [size := position]. + ^t +! ! + +!ReadWriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextPutAll: aCollection + | c | + c := super nextPutAll: aCollection. + size < position ifTrue: [size := position]. + ^c +! ! + +!ReadWriteStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextSubstring + ^self doReading: [reader nextSubstring] +! ! + +!ReadWriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextULong + ^self doReading: [reader nextULong] +! ! + +!ReadWriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextUShort + ^self doReading: [reader nextUShort] +! ! + +!ReadWriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aCollection + super on: aCollection. + reader on: contents; position: position. + limit := aCollection size. + size := 0 +! ! + +!ReadWriteStream methodsFor: 'peeking' stamp: 'KenD 28/Jun/2026 13:27:38'! +peek + reader position: position. + ^reader peek +! ! + +!ReadWriteStream methodsFor: 'peeking' stamp: 'KenD 28/Jun/2026 13:27:38'! +peek: anInteger + reader position: position. + ^reader peek: anInteger +! ! + +!ReadWriteStream methodsFor: 'peeking' stamp: 'KenD 28/Jun/2026 13:27:38'! +peekFor: token + | found | + reader position: position. + found := reader peekFor: token. + found ifTrue: [self position: reader position]. + ^found +! ! + +!ReadWriteStream methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +putBytesFrom: aByteArray from: start to: stop + super putBytesFrom: aByteArray from: start to: stop. + size < position ifTrue: [size := position] +! ! + +!ReadWriteStream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +reset + self position: 0 +! ! + +!ReadWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeToEnd + ^size - position +! ! + +!ReadWriteStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +skipSeparators + self doReading: [reader skipSeparators] +! ! + +!ReadWriteStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +skipTo: token + ^self doReading: [reader skipTo: token] +! ! + +!ReadWriteStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +throughAll: aCollection + ^self doReading: [reader throughAll: aCollection] +! ! + +!ReadWriteStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncate + limit := size := position +! ! + +!ReadWriteStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +untilAnySatisfying: aBlock + ^self doReading: [reader untilAnySatisfying: aBlock] +! ! + +!ReadWriteStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upTo: token + ^self doReading: [reader upTo: token] +! ! + +!ReadWriteStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToAll: aCollection + ^self doReading: [reader upToAll: aCollection] +! ! + +!ReadWriteStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToAny: aCollection + ^self doReading: [reader upToAny: aCollection] +! ! + +!ReadWriteStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToAnySatisfying: aBlock + ^self doReading: [reader upToAnySatisfying: aBlock] +! ! + +!ReadWriteStream methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToEnd + ^self doReading: [reader next: self sizeToEnd] +! ! + +!ReadWriteStream methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +upToWhitespace + ^self doReading: [reader upToWhitespace] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ReadWriteStream class' category: #Kernel! +ReadWriteStream class + instanceVariableNames: ''! + + +ReadWriteStream initialize! + diff --git a/modules/Kernel/Rectangle.Class.st b/modules/Kernel/Rectangle.Class.st new file mode 100644 index 00000000..aed47ad9 --- /dev/null +++ b/modules/Kernel/Rectangle.Class.st @@ -0,0 +1,508 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Rectangle category: #Kernel! +Object subclass: #Rectangle + instanceVariableNames: 'origin corner' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Rectangle commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Rectangle methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aRectangle + ^aRectangle isRectangle + and: [origin = aRectangle leftTop] + and: [corner = aRectangle rightBottom] +! ! + +!Rectangle methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +area + ^self height * self width +! ! + +!Rectangle methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +areasOutside: aRectangle + | areas y0 y1 area | + (self intersects: aRectangle) ifFalse: [^{self}]. + areas := OrderedCollection new: 4. + y0 := self top. + aRectangle top > y0 ifTrue: [ + y0 := aRectangle top. + areas addLast: (origin corner: corner x @ y0)]. + y1 := self bottom. + aRectangle bottom < y1 ifTrue: [ + y1 := aRectangle bottom. + area := self left @ y1 corner: corner. + areas addLast: area]. + aRectangle left > self left ifTrue: [ + area := self left @ y0 corner: aRectangle left @ y1. + areas addLast: area]. + aRectangle right < self right ifTrue: [ + area := aRectangle right @ y0 corner: self right @ y1. + areas addLast: area]. + ^areas +! ! + +!Rectangle methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asRectangle + ^self +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bottom + ^corner y +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bottom: aNumber + corner := corner x @ aNumber +! ! + +!Rectangle methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +bottomCenter + ^self center x @ self bottom +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bottomLeft + ^self left @ self bottom +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bottomLeft: aPoint + self + topLeft: aPoint x @ self topLeft y; + bottomRight: self bottomRight x @ aPoint y +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bottomRight + ^corner +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +bottomRight: aPoint + corner := aPoint +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +center + ^origin + corner // 2 +! ! + +!Rectangle methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +containsPoint: aPoint + ^origin <= aPoint and: [aPoint < corner] +! ! + +!Rectangle methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +containsRect: aRectangle + ^origin <= aRectangle origin and: [aRectangle corner <= corner] +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +corner + ^corner +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +corner: aPoint + corner := aPoint +! ! + +!Rectangle methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +corners + ^{origin. corner. origin x @ corner y. corner x @ origin y} +! ! + +!Rectangle methodsFor: 'movements' stamp: 'KenD 28/Jun/2026 13:27:38'! +down: delta + origin := origin down: delta. + corner := corner down: delta +! ! + +!Rectangle methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +expandBy: delta + delta isRectangle + ifTrue: [ + ^(origin leftAndUp: delta leftTop) + rightBottom: (corner translatedBy: delta rightBottom)] + ifFalse: [^(origin leftAndUp: delta) + rightBottom: (corner translatedBy: delta)] +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +extent + ^self width @ self height +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +extent: aPoint + corner := origin + aPoint +! ! + +!Rectangle methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^origin hashWith: corner +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +height + ^(origin y - corner y) abs +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +height: aNumber + corner y: origin y + aNumber +! ! + +!Rectangle methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +insetBy: delta + | o c | + delta isRectangle + ifTrue: [ + o := origin translatedBy: delta leftTop. + c := corner leftAndUp: delta rightBottom] + ifFalse: [ + o := origin translatedBy: delta. + c := corner leftAndUp: delta]. + ^o rightBottom: c +! ! + +!Rectangle methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +intersect: aRectangle + | o c | + aRectangle isNil ifTrue: [^self]. + o := origin max: aRectangle origin. + c := corner min: aRectangle corner. + o x > c x ifTrue: [c x: o x]. + o y > c y ifTrue: [c y: o y]. + ^o corner: c +! ! + +!Rectangle methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +intersects: aRectangle + ^origin < aRectangle rightBottom and: [aRectangle leftTop < corner] +! ! + +!Rectangle methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isRectangle + ^true +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +left + ^origin x +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +left: aNumber + origin := aNumber @ origin y +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftBottom + ^self left @ self bottom +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftBottom: aPoint + origin := aPoint x @ self top. + corner := self right @ aPoint y +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftBottom: point extent: extent + origin := point up: extent y. + corner := point right: extent x +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftBottom: point1 rightTop: point2 + origin := point1 x @ point2 y. + corner := point2 x @ point1 y +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftCenter + ^self left @ self center y +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftTop + ^origin +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftTop: aPoint + origin := aPoint +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftTop: originPoint extent: extent + corner := originPoint + extent. + origin := originPoint +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftTop: oPoint rightBottom: cPoint + origin := oPoint. + corner := cPoint +! ! + +!Rectangle methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +merge: aRectangle + | o c | + aRectangle isNil ifTrue: [^self]. + o := origin min: aRectangle leftTop. + c := corner max: aRectangle rightBottom. + ^o rightBottom: c +! ! + +!Rectangle methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +mergeWith: aRectangle + origin := origin min: aRectangle origin. + corner := corner max: aRectangle corner +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +moveBy: aPoint + origin := origin + aPoint. + corner := corner + aPoint +! ! + +!Rectangle methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +moveTo: aPoint + self moveBy: aPoint - origin +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +origin + ^origin +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +origin: aPoint + self topLeft: aPoint +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +origin: originPoint corner: cornerPoint + self leftTop: originPoint rightBottom: cornerPoint +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +origin: oPoint extent: ePoint + self origin: oPoint corner: oPoint + ePoint +! ! + +!Rectangle methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + origin printOn: aStream. + aStream nextPutAll: ' rightBottom: '. + corner printOn: aStream +! ! + +!Rectangle methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +relativeTo: aRectangle + | extent | + extent := aRectangle extent. + (extent x = 0 or: [extent y = 0]) ifTrue: [^self]. + ^origin - aRectangle leftTop / extent extent: self extent / extent +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +right + ^corner x +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +right: aNumber + corner := aNumber @ corner y +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightBottom + ^corner +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightBottom: aPoint + corner := aPoint +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightBottom: point extent: extent + origin := (point up: extent y) left: extent x. + corner := point +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightCenter + ^self right @ self center y +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightTop + ^self right @ self top +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightTop: aPoint + origin := self left @ aPoint y. + corner := aPoint x @ self bottom +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +round + origin := origin rounded. + corner := corner rounded +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +rounded + origin := origin rounded. + corner := corner rounded +! ! + +!Rectangle methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +scaleBy: delta + ^origin * delta rightBottom: corner * delta +! ! + +!Rectangle methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +scaleTo: aRectangle + | scaled | + scaled := aRectangle scaleBy: self extent. + ^scaled truncated moveBy: self origin +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +signedHeight + ^corner y - origin y +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +signedWidth + ^corner x - origin x +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +top + ^origin y +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +top: aNumber + origin := origin x @ aNumber +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +topCenter + ^self center x @ self top +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +topLeft + ^origin +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +topLeft: aPoint + origin := aPoint +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +topRight + ^self right @ self top +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +topRight: aPoint + self + topLeft: self left @ aPoint y; + bottomRight: aPoint x @ self bottom +! ! + +!Rectangle methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +translateBy: delta + ^origin + delta rightBottom: corner + delta +! ! + +!Rectangle methodsFor: 'movements' stamp: 'KenD 28/Jun/2026 13:27:38'! +translatedBy: delta + ^origin + delta rightBottom: corner + delta +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncate + origin := origin truncated. + corner := corner truncated +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncated + ^origin truncated corner: corner truncated +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +width + ^(corner x - origin x) abs +! ! + +!Rectangle methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +width: anInteger + corner x: origin x + anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Rectangle class' category: #Kernel! +Rectangle class + instanceVariableNames: ''! + +!Rectangle class methodsFor: 'inspecting' stamp: 'KenD 28/Jun/2026 13:27:38'! +aspects + ^#(#width #height) +! ! + +!Rectangle class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftBottom: leftBottomPoint extent: extentPoint + ^self new leftBottom: leftBottomPoint extent: extentPoint +! ! + +!Rectangle class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftBottom: leftBottomPoint rightTop: rightTopPoint + ^self new leftBottom: leftBottomPoint rightTop: rightTopPoint +! ! + +!Rectangle class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftTop: leftTopPoint extent: extentPoint + ^self new leftTop: leftTopPoint extent: extentPoint +! ! + +!Rectangle class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +leftTop: leftTopPoint rightBottom: rightBottomPoint + ^self new leftTop: leftTopPoint rightBottom: rightBottomPoint +! ! + +!Rectangle class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +origin: originPoint corner: cornerPoint + ^self new origin: originPoint corner: cornerPoint +! ! + +!Rectangle class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +origin: originPoint extent: extentPoint + ^self new origin: originPoint extent: extentPoint +! ! + +!Rectangle class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +rightBottom: rightBottomPoint extent: extentPoint + ^self new rightBottom: rightBottomPoint extent: extentPoint +! ! + + diff --git a/modules/Kernel/Recursion.Class.st b/modules/Kernel/Recursion.Class.st new file mode 100644 index 00000000..6b4a0df3 --- /dev/null +++ b/modules/Kernel/Recursion.Class.st @@ -0,0 +1,72 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Recursion category: #Kernel! +Error subclass: #Recursion + instanceVariableNames: 'object' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Recursion commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Recursion methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +description + ^'recursive structure found at ' , object class name withArticle +! ! + +!Recursion methodsFor: 'signaling' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalOn: anObject + object := anObject. + ^self signal +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Recursion class' category: #Kernel! +Recursion class + instanceVariableNames: ''! + +!Recursion class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +check: anObject in: aSet while: aBlock + ^(aSet includes: anObject) ifTrue: [self signalOn: anObject] ifFalse: [ + aSet add: anObject. + aBlock ensure: [aSet remove: anObject]] +! ! + +!Recursion class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +checkOn: anObject while: aBlock + ^self check: anObject in: Recursion recursionSet while: aBlock +! ! + +!Recursion class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +checkOn: anObject while: aBlock onSignal: exceptionBlock + | set | + set := Recursion recursionSet. + ^[self check: anObject in: set while: aBlock] on: self do: exceptionBlock +! ! + +!Recursion class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +recursionSet + | handler set | + handler := Processor activeProcess. + [ + handler := handler notNil ifTrue: [handler findHandlerFor: self new]. + handler notNil + ifTrue: [set := handler propertyAt: #recursionSet ifAbsent: nil]. + handler notNil and: [set isNil]] + whileTrue: [handler := handler nextHandler]. + ^set ifNil: [ + Processor activeProcess exceptionHandler + propertyAt: #recursionSet + ifAbsentPut: [IdentitySet new]] +! ! + +!Recursion class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +signalOn: anObject + ^self new signalOn: anObject +! ! + + diff --git a/modules/Kernel/ScaledDecimal.Class.st b/modules/Kernel/ScaledDecimal.Class.st new file mode 100644 index 00000000..b74e948f --- /dev/null +++ b/modules/Kernel/ScaledDecimal.Class.st @@ -0,0 +1,294 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ScaledDecimal category: #Kernel! +Fraction subclass: #ScaledDecimal + instanceVariableNames: 'scale' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ScaledDecimal commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aNumber + ^aNumber class == self class + ifTrue: [aNumber subtractFromScaledDecimal: self] + ifFalse: [self retry: #'-' with: aNumber] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +* aNumber + ^aNumber class == self class + ifTrue: [aNumber multiplyScaledDecimal: self] + ifFalse: [self retry: #'*' with: aNumber] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +/ aNumber + ^aNumber class == self class + ifTrue: [aNumber divideIntoScaledDecimal: self] + ifFalse: [self retry: #'/' with: aNumber] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +// aNumber + | q quo | + q := self / aNumber. + quo := q floor. + ^(q negative andNot: [q = quo]) ifTrue: [quo] ifFalse: [quo - 1] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aNumber + ^aNumber class == self class + ifTrue: [aNumber addToScaledDecimal: self] + ifFalse: [self retry: #'+' with: aNumber] +! ! + +!ScaledDecimal methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aNumber + aNumber = 0 ifTrue: [^numerator < 0]. + ^self - aNumber < 0 +! ! + +!ScaledDecimal methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aNumber + ^self < aNumber or: [self = aNumber] +! ! + +!ScaledDecimal methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aNumber + self class == aNumber class ifTrue: [^self asFraction = aNumber asFraction]. + ^self asFraction = aNumber +! ! + +!ScaledDecimal methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aNumber + aNumber = 0 ifTrue: [^numerator > 0]. + ^self - aNumber > 0 +! ! + +!ScaledDecimal methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aNumber + ^self > aNumber or: [self = aNumber] +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +addToScaledDecimal: aScaledDecimal + | s den fraction | + s := self scale max: aScaledDecimal scale. + den := aScaledDecimal denominator. + fraction := denominator = den + ifTrue: [ + self class + numerator: numerator + aScaledDecimal numerator + denominator: denominator] + ifFalse: [ + self class + numerator: numerator * den + (aScaledDecimal numerator * denominator) + denominator: denominator * den]. + ^fraction scale: s; reduced +! ! + +!ScaledDecimal methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asFloat + ^numerator asFloat / denominator +! ! + +!ScaledDecimal methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asFraction + ^Fraction numerator: numerator denominator: denominator +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +coerce: aNumber + ^self class fromNumber: aNumber scale: scale +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +divideIntoScaledDecimal: aScaledDecimal + | s fraction | + s := scale max: aScaledDecimal scale. + fraction := self class + numerator: aScaledDecimal numerator * denominator + denominator: aScaledDecimal denominator * numerator. + ^fraction scale: s; reduced +! ! + +!ScaledDecimal methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFraction + ^false +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +multiplyScaledDecimal: aScaledDecimal + | s fraction | + s := scale max: aScaledDecimal scale. + fraction := self class + numerator: aScaledDecimal numerator * numerator + denominator: aScaledDecimal denominator * denominator. + ^fraction scale: s; reduced +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +negated + ^self class fromNumber: self asFraction negated scale: scale +! ! + +!ScaledDecimal methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + | scaler scaled quo rem | + scaler := 10 raisedToInteger: scale. + scaled := numerator * scaler + (denominator bitShift: -1) // denominator. + numerator < 0 ifTrue: [ + aStream nextPut: $-. + scaled := scaled negated]. + quo := scaled // scaler. + rem := scaled \\ scaler. + quo printOn: aStream. + scale > 0 ifTrue: [aStream nextPut: $.]. + scale timesRepeat: [ + rem := rem * 10. + aStream nextPut: (Character digitValue: rem // scaler). + rem := rem \\ scaler]. + aStream nextPut: $s; nextPutAll: scale asString +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +raisedTo: aNumber + | fraction | + fraction := super raisedTo: aNumber. + ^self class fromNumber: fraction scale: scale +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +raisedToInteger: aNumber + | fraction | + fraction := super raisedToInteger: aNumber. + ^self class fromNumber: fraction scale: scale +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +reciprocal + ^self class fromNumber: self asFraction reciprocal scale: scale +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reduced + | gcd | + gcd := numerator gcd: denominator. + gcd = 1 ifTrue: [^self]. + ^self class + numerator: numerator // gcd + denominator: denominator // gcd + scale: self scale +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +retry: selector with: argument + ^argument isFloat + ifTrue: [(argument coerce: self) perform: selector with: argument] + ifFalse: [self perform: selector with: (self coerce: argument)] +! ! + +!ScaledDecimal methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +scale + ^scale +! ! + +!ScaledDecimal methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +scale: anInteger + scale := anInteger +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +setNumerator: num denominator: den scale: s + den = 0 ifTrue: [^self zeroDivisorOn: #setNumerator:denominator:scale:]. + denominator := den truncated abs. + den negative ifTrue: [numerator := numerator negated]. + numerator := num truncated. + scale := s truncated +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +sqrt + | sqrt | + sqrt := self asFraction sqrt. + ^sqrt isFloat + ifTrue: [sqrt] + ifFalse: [ScaledDecimal fromNumber: sqrt scale: scale] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +squared + ^super squared scale: scale +! ! + +!ScaledDecimal methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + (denominator = 1 or: [(10 raisedTo: scale) \\ denominator = 0]) + ifTrue: [^self printOn: aStream]. + numerator storeOn: aStream. + aStream nextPut: $/. + denominator storeOn: aStream. + aStream nextPut: $s; nextPutAll: scale asString +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +subtractFromScaledDecimal: aScaledDecimal + | s den fraction | + s := scale max: aScaledDecimal scale. + den := aScaledDecimal denominator. + fraction := denominator = den + ifTrue: [ + self class + numerator: aScaledDecimal numerator - numerator + denominator: denominator] + ifFalse: [ + self class + numerator: aScaledDecimal numerator * denominator - (numerator * den) + denominator: denominator * den]. + ^fraction scale: s; reduced +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ScaledDecimal class' category: #Kernel! +ScaledDecimal class + instanceVariableNames: ''! + +!ScaledDecimal class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromNumber: aNumber scale: anInteger + | fraction | + fraction := aNumber asFraction. + ^self + numerator: fraction numerator + denominator: fraction denominator + scale: anInteger +! ! + +!ScaledDecimal class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString + | value i n num den | + value := super fromString: aString. + value class == self ifTrue: [^value]. + i := aString indexOf: $.. + i = 0 ifTrue: [^self fromNumber: value scale: 0]. + n := aString size - i. + num := (aString copyWithout: $.) asInteger. + den := 10 raisedToInteger: n. + ^self fromNumber: num / den scale: n +! ! + +!ScaledDecimal class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +numerator: numerator denominator: denominator scale: scale + " + ScaledDecimal numerator: 1 denominator: 3 scale: 2 + " + ^(self numerator: numerator denominator: denominator) scale: scale +! ! + + diff --git a/modules/Kernel/Semaphore.Class.st b/modules/Kernel/Semaphore.Class.st new file mode 100644 index 00000000..ab722ed8 --- /dev/null +++ b/modules/Kernel/Semaphore.Class.st @@ -0,0 +1,85 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Semaphore category: #Kernel! +Object subclass: #Semaphore + instanceVariableNames: 'signals waiting' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Semaphore commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Semaphore methodsFor: 'delaying' stamp: 'KenD 28/Jun/2026 13:27:38'! +critical: aBlock + ^[ + self wait. + aBlock value] + ensure: [self signal] +! ! + +!Semaphore methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasWaitingProcesses + ^waiting notEmpty +! ! + +!Semaphore methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + waiting := OrderedCollection new. + signals := 0 +! ! + +!Semaphore methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSignaled + ^signals > 0 +! ! + +!Semaphore methodsFor: 'synchronization' stamp: 'KenD 28/Jun/2026 13:27:38'! +signal + | enabled | + enabled := Processor enableInterrupts: false. + [waiting notEmpty and: [waiting first hasFinished]] + whileTrue: [ + signals := signals + 1. + waiting removeFirst]. + signals := signals + 1. + signals < 1 ifTrue: [waiting removeFirst wakeUp]. + enabled ifTrue: [Processor enableInterrupts: true] +! ! + +!Semaphore methodsFor: 'synchronization' stamp: 'KenD 28/Jun/2026 13:27:38'! +wait + | enabled active | + enabled := Processor enableInterrupts: false. + signals := signals - 1. + signals < 0 ifTrue: [ + active := Processor activeProcess. + active canBeSuspended + ifFalse: [^self error: 'The process can not be suspended at this time']. + waiting addLast: active. + active sleepOn: self]. + enabled ifTrue: [Processor enableInterrupts: true] +! ! + +!Semaphore methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +waitingProcesses + ^waiting +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Semaphore class' category: #Kernel! +Semaphore class + instanceVariableNames: ''! + +!Semaphore class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +forMutualExclusion + ^self new signal +! ! + + +Semaphore initialize! + diff --git a/modules/Kernel/SequenceableCollection.Class.st b/modules/Kernel/SequenceableCollection.Class.st new file mode 100644 index 00000000..f4318ea8 --- /dev/null +++ b/modules/Kernel/SequenceableCollection.Class.st @@ -0,0 +1,836 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #SequenceableCollection category: #Kernel! +Collection subclass: #SequenceableCollection + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!SequenceableCollection commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!SequenceableCollection methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +, aSequenceableCollection + | size n | + aSequenceableCollection isSequenceableCollection ifFalse: [ + self + error: 'Instances of ' , aSequenceableCollection class name + , ' are not indexable']. + size := self size. + n := size + aSequenceableCollection size. + ^(self species new: n) + replaceFrom: 1 to: size with: self startingAt: 1; + replaceFrom: size + 1 to: n with: aSequenceableCollection startingAt: 1 +! ! + +!SequenceableCollection methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aCollection + | size | + self == aCollection ifTrue: [^true]. + self class == aCollection class ifFalse: [^false]. + size := self size. + size !!= aCollection size ifTrue: [^false]. + 1 to: size do: [:i | (self at: i) = (aCollection at: i) ifFalse: [^false]]. + ^true +! ! + +!SequenceableCollection methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +after: anObject + ^self after: anObject ifAbsent: [self errorNotFound] +! ! + +!SequenceableCollection methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +after: anObject ifAbsent: absentBlock + | i | + i := self indexOf: anObject ifAbsent: [^absentBlock value]. + ^self at: i + 1 ifAbsent: absentBlock +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +allButFirst + ^self allButFirst: 1 +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +allButFirst: n + ^self copyFrom: n + 1 +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +allButIndex: anInteger + | m copy | + m := self size - 1. + copy := self class new: m. + ^copy + replaceFrom: 1 + to: anInteger - 1 + with: self + startingAt: 1; + replaceFrom: anInteger + to: m + with: self + startingAt: anInteger + 1 +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +allButLast + ^self allButLast: 1 +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +allButLast: n + ^self copyFrom: 1 to: self size - n +! ! + +!SequenceableCollection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asStream + ^ReadWriteStream on: self +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger ifAbsent: aBlock + ^(anInteger between: 1 and: self size) + ifTrue: [self at: anInteger] + ifFalse: [aBlock value] +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atAll: aCollection put: anObject + aCollection do: [:i | self at: i put: anObject] +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atAllPut: anObject + self size > 0 + ifTrue: [self replaceFrom: 1 to: self size withObject: anObject] +! ! + +!SequenceableCollection methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +before: anObject + ^self before: anObject ifAbsent: [self errorNotFound] +! ! + +!SequenceableCollection methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +before: anObject ifAbsent: absentBlock + | index | + index := self indexOf: anObject ifAbsent: [^absentBlock value]. + index = 1 ifTrue: [^absentBlock value]. + ^self at: index - 1 +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +beginsWith: aCollection + self size < aCollection size ifTrue: [^false]. + 1 + to: aCollection size + do: [:i | (self at: i) = (aCollection at: i) ifFalse: [^false]]. + ^true +! ! + +!SequenceableCollection methodsFor: 'validation' stamp: 'KenD 28/Jun/2026 13:27:38'! +checkIndex: anInteger + anInteger isInteger ifFalse: [^self error: 'Non integer index']. + (anInteger between: 1 and: self size) + ifFalse: [^self outOfBoundsIndex: anInteger] +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyFrom: start + ^self copyFrom: start to: self size +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyFrom: start to: stop + | size copy | + size := stop - start + 1 max: 0. + copy := self species new: size. + ^copy + replaceFrom: 1 + to: size + with: self + startingAt: start +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyReplaceFrom: start to: stop with: aCollection + | n m | + n := aCollection size. + m := self size + n - (stop - start + 1). + ^(self species new: m) + replaceFrom: 1 to: start - 1 with: self startingAt: 1; + replaceFrom: start to: start + n - 1 with: aCollection startingAt: 1; + replaceFrom: start + n to: m with: self startingAt: stop + 1 +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyTo: end + ^self copyFrom: 1 to: end +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyWith: anObject + | size | + size := self size. + ^(self species new: size + 1) + at: size + 1 put: anObject; + replaceFrom: 1 to: size with: self startingAt: 1 +! ! + +!SequenceableCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyWithout: anObject + | n i1 copy j | + n := self size. + copy := self copy. + n = 0 ifTrue: [^self]. + j := 1. + i1 := 0. + [i1 + 1 <= n] whileTrue: [| i0 k | + i0 := i1 + 1. + i1 := self indexOf: anObject startingAt: i0 ifAbsent: [n + 1]. + k := i1 - i0. + copy replaceFrom: j to: j + k - 1 with: self startingAt: i0. + j := j + k]. + ^j - 1 = n ifTrue: [copy] ifFalse: [copy copyTo: j - 1] +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + 1 to: self size do: [:i | | element | + element := self atValid: i. + aBlock evaluateWith: element] +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +endsWith: aCollection + | m n | + n := self size. + m := aCollection size. + n < m ifTrue: [^false]. + 1 + to: m + do: [:i | (self at: n - i + 1) = (aCollection at: m - i + 1) ifFalse: [^false]]. + ^true +! ! + +!SequenceableCollection methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +findFirst: aBlock + ^self findFirst: aBlock ifAbsent: [self errorNotFound] +! ! + +!SequenceableCollection methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +findFirst: aBlock ifAbsent: absentBlock + ^self findFirst: aBlock startingAt: 1 ifAbsent: absentBlock +! ! + +!SequenceableCollection methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +findFirst: aBlock startingAt: index ifAbsent: absentBlock + | size i | + size := self size. + i := index. + [i <= size] whileTrue: [ + (aBlock evaluateWith: (self at: i)) ifTrue: [^i]. + i := i + 1]. + ^absentBlock value +! ! + +!SequenceableCollection methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +findLast: aBlock + ^self findLast: aBlock ifAbsent: [self errorNotFound] +! ! + +!SequenceableCollection methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +findLast: aBlock ifAbsent: absentBlock + self size + to: 1 + by: -1 + do: [:i | (aBlock evaluateWith: (self at: i)) ifTrue: [^i]]. + ^absentBlock value +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +first + ^self at: 1 +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +fold: aBlock + " + #('Hello' 'there' 'from' 'Bee Smalltalk!!') fold: [:a :b | a , ' ', b] + " + | fold | + fold := self at: 1. + 2 + to: self size + do: [:i | fold := aBlock evaluateWith: fold with: (self at: i)]. + ^fold +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +fourth + ^self at: 4 +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +from: start to: stop findFirst: aBlock ifAbsent: errorBlock + start to: stop do: [:i | | found item | + item := self at: i. + found := aBlock evaluateWith: item. + found ifTrue: [^i]]. + ^errorBlock value +! ! + +!SequenceableCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +growSize + | min | + min := self size max: 10. + ^min min: 1000000 +! ! + +!SequenceableCollection methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^self size +! ! + +!SequenceableCollection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasIndexedSlots + ^true +! ! + +!SequenceableCollection methodsFor: 'sorting' stamp: 'KenD 28/Jun/2026 13:27:38'! +hybridSort + self hybridSort: self +! ! + +!SequenceableCollection methodsFor: 'sorting' stamp: 'KenD 28/Jun/2026 13:27:38'! +hybridSort: aBlock + self + hybridSortFrom: 1 + to: self size + with: aBlock + scratch: (Array new: 10) +! ! + +!SequenceableCollection methodsFor: 'sorting' stamp: 'KenD 28/Jun/2026 13:27:38'! +hybridSortFrom: start to: stop with: aBlock scratch: anArray + " + Sort elements i through j of self to be non-descending according to sortBlock. + Use quicksort for large ranges and insertion sort for ranges within scratch size. + The prefix d means the data at that index. + #(1 3 2 6 7 5) hybridSortFrom: 1 to: 6 with: [:a :b | a <= b] scratch: (Array new: 3) + " + | di dij dj tt ij k l n | + n := stop + 1 - start. + n <= 1 ifTrue: [^self]. + n <= anArray size ifTrue: [ + ^self + insertSortFrom: start + to: stop + with: aBlock + scratch: anArray]. + "Assume more than three elements." + "Sort di,dj and dij." + di := self basicAt: start. + dj := self basicAt: stop. + (aBlock value: di value: dj) ifFalse: [ + self swap: start with: stop. + tt := di. + di := dj. + dj := tt]. + "i.e., should di precede dj?" + ij := start + stop // 2. + "ij is the midpoint of i and j." + dij := self basicAt: ij. + ("Sort di, dij, dj. Make dij be their median." + aBlock value: di value: dij "i.e. should di precede dij?") + ifTrue: [ + (aBlock value: dij value: dj) ifFalse: [ + "i.e., should dij precede dj?" + self swap: stop with: ij. + dij := dj]] + ifFalse: [ + "i.e. di should come after dij" + self swap: start with: ij. + dij := di]. + "Find k>i and l 0] whileTrue: [anObject = (self at: i) ifTrue: [^true]]. + ^false +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +increasingIncludes: anObject + | stop start | + stop := self size. + stop = 0 ifTrue: [^false]. + start := 1. + anObject < (self at: 1) ifTrue: [^false]. + (self at: stop) < anObject ifTrue: [^false]. + [start <= stop] whileTrue: [| mid token | + mid := start + stop // 2. + token := self at: mid. + anObject = token ifTrue: [^true]. + anObject < token ifTrue: [stop := mid - 1] ifFalse: [start := mid + 1]]. + ^false +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: anObject + ^self indexOf: anObject ifAbsent: 0 +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: anObject between: start and: end ifAbsent: aBlock + start to: end do: [:i | (self at: i) = anObject ifTrue: [^i]]. + ^aBlock value +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: anObject ifAbsent: aBlock + ^self indexOf: anObject startingAt: 1 ifAbsent: aBlock +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: anObject startingAt: start ifAbsent: aBlock + ^self + indexOf: anObject + between: start + and: self size + ifAbsent: aBlock +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfIdentical: anObject + ^self indexOfIdentical: anObject ifAbsent: 0 +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfIdentical: anObject ifAbsent: aBlock + 1 to: self size do: [:i | (self at: i) == anObject ifTrue: [^i]]. + ^aBlock value +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfSubcollection: aCollection + ^self indexOfSubcollection: aCollection startingAt: 1 +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfSubcollection: aCollection from: start to: stop td1: aDictionary + | m k | + m := aCollection size. + m = 0 ifTrue: [^0]. + k := start. + [k + m - 1 <= stop] whileTrue: [| i object delta | + i := 1. + [i <= m and: [(aCollection at: i) = (self at: k + i - 1)]] + whileTrue: [i := i + 1]. + i > m ifTrue: [^k]. + k + m > stop ifTrue: [^0]. + object := self at: k + m. + delta := aDictionary at: object ifAbsent: [m + 1]. + delta isNil ifTrue: [delta := m + 1]. + k := k + delta]. + ^0 +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfSubcollection: aCollection startingAt: anInteger + | m n i first | + m := aCollection size. + m = 0 ifTrue: [^0]. + n := self size - m + 1. + i := anInteger. + first := aCollection at: 1. + [i <= n] whileTrue: [| j | + (self at: i) = first ifTrue: [ + j := 2. + [j <= m and: [(self at: i + j - 1) = (aCollection at: j)]] + whileTrue: [j := j + 1]. + j > m ifTrue: [^i]]. + i := i + 1]. + ^0 +! ! + +!SequenceableCollection methodsFor: 'sorting' stamp: 'KenD 28/Jun/2026 13:27:38'! +insertSortFrom: start to: stop with: aBlock scratch: anArray + " + #(1 3 2 6 7 5) insertSortFrom: 1 to: 6 with: [:a :b | a <= b] scratch: (Array new: 6) + " + | n | + n := stop + 1 - start. + n <= 1 ifTrue: [^self]. + anArray at: 1 put: (self at: start). + 2 to: n do: [:i | | ai j s | + ai := self at: start + i - 1. + j := 1. + [j < i and: [aBlock value: (anArray at: j) value: ai]] + whileTrue: [j := j + 1]. + j < i ifTrue: [ + s := i. + [j < s] whileTrue: [ + anArray at: s put: (anArray at: s - 1). + s := s - 1]]. + anArray at: j put: ai]. + 1 to: n do: [:i | self at: start + i - 1 put: (anArray at: i)] +! ! + +!SequenceableCollection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSequenceableCollection + ^true +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +last + ^self at: self size +! ! + +!SequenceableCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +occurrencesOf: anObject + | count | + count := 0. + 1 + to: self size + do: [:i | (self at: i) = anObject ifTrue: [count := count + 1]]. + ^count +! ! + +!SequenceableCollection methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +outOfBoundsIndex: anInteger + ^self + error: 'index: ' , anInteger printString + , ' is outside of collection bounds' +! ! + +!SequenceableCollection methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printElementText: element on: rtf position: i + rtf nextPutAll: i asString; tab; tab. + element printOn: rtf +! ! + +!SequenceableCollection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +readStream + ^InternalReadStream on: self +! ! + +!SequenceableCollection methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceBackwardFrom: stop to: start with: aCollection startingAt: position + | i j | + i := stop. + j := position. + [start <= i] whileTrue: [ + self at: i put: (aCollection at: j). + i := i - 1. + j := j - 1] +! ! + +!SequenceableCollection methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceForwardFrom: start to: stop with: aCollection startingAt: position + | i j | + i := start. + j := position. + [i <= stop] whileTrue: [ + self at: i put: (aCollection at: j). + i := i + 1. + j := j + 1] +! ! + +!SequenceableCollection methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop with: aCollection + stop - start + 1 <= aCollection size + ifFalse: [^self error: 'size of replacement does not match']. + self replaceFrom: start to: stop with: aCollection startingAt: 1 +! ! + +!SequenceableCollection methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop with: aCollection startingAt: position + | end | + start > stop ifTrue: [^self]. + (self == aCollection and: [ + end := position + stop - start. + start between: position and: end]) + ifTrue: [self + replaceBackwardFrom: stop + to: start + with: aCollection + startingAt: end] + ifFalse: [ + self + replaceForwardFrom: start + to: stop + with: aCollection + startingAt: position] +! ! + +!SequenceableCollection methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop withObject: anObject + start to: stop do: [:i | self at: i put: anObject]. + ^anObject +! ! + +!SequenceableCollection methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replace: anObject with: anotherObject + self + withIndexDo: [:e :i | e = anObject ifTrue: [self at: i put: anotherObject]] +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +reverse + ^self reversed +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +reversed + | copy n | + n := self size. + copy := self class new: n withAll: nil. + 1 to: n do: [:i | | xi | + xi := self at: i. + copy at: n - i + 1 put: xi]. + ^copy +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +reverseDetect: aBlock + ^self reverseDetect: aBlock ifNone: [self errorNotFound] +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +reverseDetect: aBlock ifNone: exceptionBlock + self reverseDo: [:e | (aBlock evaluateWith: e) ifTrue: [^e]]. + ^exceptionBlock value +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +reverseDo: aBlock + self size to: 1 by: -1 do: [:i | aBlock evaluateWith: (self atValid: i)] +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +second + ^self at: 2 +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self subclassResponsibility +! ! + +!SequenceableCollection methodsFor: 'sorting' stamp: 'KenD 28/Jun/2026 13:27:38'! +sort + self sortBy: self +! ! + +!SequenceableCollection methodsFor: 'sorting' stamp: 'KenD 28/Jun/2026 13:27:38'! +sort: start to: stop with: block + | i0 i1 | + i0 := start. + i1 := stop. + [| x1 x0 mid pivot last i | + i1 - i0 <= 1 ifTrue: [ + (i0 < i1 and: [ + x1 := self at: i1. + x0 := self at: i0. + (block value: x1 value: x0) value]) + ifTrue: [ + self + at: i0 put: x1; + at: i1 put: x0]. + ^self]. + mid := i0 + i1 // 2. + pivot := self at: mid. + self at: mid put: (self at: i0). + i := last := i0. + [ + i := i + 1. + x0 := self at: i. + ((block value: x0 value: pivot) value andNot: [ + last := last + 1. + last = i]) + ifTrue: [ + self + at: i put: (self at: last); + at: last put: x0]. + i < i1] whileTrue. + self + at: i0 put: (self at: last); + at: last put: pivot. + mid < last + ifTrue: [ + self sort: last + 1 to: i1 with: block. + i1 := last - 1] + ifFalse: [ + self sort: i0 to: last - 1 with: block. + i0 := last + 1]] repeat +! ! + +!SequenceableCollection methodsFor: 'sorting' stamp: 'KenD 28/Jun/2026 13:27:38'! +sortBy: aBlock + self sort: 1 to: self size with: aBlock +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +swap: index1 with: index2 + | temp | + temp := self at: index1. + self at: index1 put: (self at: index2). + self at: index2 put: temp. +! ! + +!SequenceableCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +td1 + | m td1 | + m := self size. + td1 := Dictionary new: m. + m to: 1 by: -1 do: [:i | | object | + object := self at: i. + td1 at: object ifAbsentPut: [m - i + 1]]. + ^td1 +! ! + +!SequenceableCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +third + ^self at: 3 +! ! + +!SequenceableCollection methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: object1 value: object2 + ^[object1 <= object2] on: Error do: [object2 >= object1] +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aCollection collect: aBlock in: rCollection + | n | + n := self size. + 1 to: n do: [:i | | ai bi value | + ai := self atValid: i. + bi := aCollection at: i. + value := aBlock evaluateWith: ai with: bi. + rCollection add: value]. + ^rCollection +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aCollection do: aBlock + self size = aCollection size + ifFalse: [^self error: 'The collections have different sizes']. + 1 + to: self size + do: [:i | aBlock value: (self atValid: i) value: (aCollection atValid: i)] +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aCollection withIndexDo: aBlock + aCollection size = self size + ifFalse: [self error: 'both collections must have the same size']. + 1 + to: self size + do: [:i | aBlock + value: (self atValid: i) + value: (aCollection atValid: i) + value: i] +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withIndexCollect: aBlock + ^self withIndexCollect: aBlock in: (self class new: self size) +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withIndexCollect: aBlock in: aCollection + | size | + size := self size. + 1 + to: size + do: [:i | aCollection add: (aBlock value: (self atValid: i) value: i)]. + ^aCollection +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withIndexDo: aBlock + 1 to: self size do: [:i | aBlock value: (self atValid: i) value: i] +! ! + +!SequenceableCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withIndexSelect: aBlock + | i | + i := 0. + ^self select: [:element | + i := i + 1. + aBlock evaluateWith: element with: i] +! ! + +!SequenceableCollection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +writeStream + ^InternalWriteStream on: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SequenceableCollection class' category: #Kernel! +SequenceableCollection class + instanceVariableNames: ''! + +!SequenceableCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: size withAll: value + | collection | + collection := self new: size. + value notNil ifTrue: [1 to: size do: [:i | collection at: i put: value]]. + ^collection +! ! + +!SequenceableCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +streamContents: aBlock + | stream | + stream := (self new: 100) writeStream. + aBlock value: stream. + ^stream contents +! ! + +!SequenceableCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: aCollection + | new idx | + new := self new: aCollection size. + idx := 1. + aCollection do: [:element | + new at: idx put: element. + idx := idx + 1]. + ^new +! ! + + diff --git a/modules/Kernel/Set.Class.st b/modules/Kernel/Set.Class.st new file mode 100644 index 00000000..64831087 --- /dev/null +++ b/modules/Kernel/Set.Class.st @@ -0,0 +1,62 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Set category: #Kernel! +HashedCollection subclass: #Set + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Set commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Set methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aSet + self == aSet ifTrue: [^true]. + (aSet isKindOf: Set) ifFalse: [^false]. + self size = aSet size ifFalse: [^false]. + self do: [:element | (aSet includes: element) ifFalse: [^false]]. + ^true +! ! + +!Set methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyWithout: anObject + ^self copy remove: anObject ifAbsent: nil; yourself +! ! + +!Set methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +includes: element + tally = 0 ifTrue: [^false]. + table lookupKey: element ifAbsent: [^false]. + ^true +! ! + +!Set methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +intersection: aCollection + | n set | + n := self size min: aCollection size. + set := self class new: n. + ^aCollection select: [:each | self includes: each] in: set +! ! + +!Set methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookup: anObject + ^table lookupKey: anObject +! ! + +!Set methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +rebuildOn: aSet + self basicDo: [:element | aSet basicAdd: element]. + table := aSet contents. + tally := aSet size +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Set class' category: #Kernel! +Set class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/SmallInteger.Class.st b/modules/Kernel/SmallInteger.Class.st new file mode 100644 index 00000000..91d06722 --- /dev/null +++ b/modules/Kernel/SmallInteger.Class.st @@ -0,0 +1,405 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #SmallInteger category: #Kernel! +Integer subclass: #SmallInteger + instanceVariableNames: '' + classVariableNames: 'Maximum Minimum' + poolDictionaries: '' + category: 'Kernel'! +!SmallInteger commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aNumber + aNumber _isSmallInteger ifFalse: [^(aNumber - self) negated]. + ^(self _smiMinus: aNumber) ifNil: [self asLargeInteger - aNumber] +! ! + +!SmallInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +!!= aNumber + ^self errorVMSpecific +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +% aNumber + ^self \\ aNumber +! ! + +!SmallInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +& anInteger + ^self bitAnd: anInteger +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +* aNumber + ^self errorVMSpecific +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +// aNumber + | result quotient answer | + aNumber == 0 ifTrue: [^self zeroDivisorOn: #'//']. + aNumber _isSmallInteger + ifTrue: [ + result := self _quotientTowardZero: aNumber. + ^(self >= 0 = (aNumber >= 0) or: [result * aNumber = self]) + ifTrue: [result] + ifFalse: [result - 1]] + ifFalse: [ + aNumber isInteger + ifTrue: [^self = 0 | (self positive = aNumber positive) + ifTrue: [0] + ifFalse: [-1]]. + quotient := self / aNumber. + answer := quotient truncated. + ^(quotient < 0 and: [quotient !!= answer]) + ifTrue: [answer - 1] + ifFalse: [answer]] +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +\\ aNumber + self errorVMSpecific +! ! + +!SmallInteger methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isSmallInteger + ^true +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +| anInteger + ^self bitOr: anInteger +! ! + +!SmallInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +~= aNumber + ^aNumber ~= self +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aNumber + self errorVMSpecific +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aNumber + ^aNumber _isSmallInteger + ifTrue: [self _smiLowerThan: aNumber] + ifFalse: [aNumber > self] +! ! + +!SmallInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aNumber + ^aNumber _isSmallInteger + ifTrue: [self _smiLowerEqualThan: aNumber] + ifFalse: [aNumber >= self] +! ! + +!SmallInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aNumber + ^self errorVMSpecific +! ! + +!SmallInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aNumber + ^self errorVMSpecific +! ! + +!SmallInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aNumber + ^self errorVMSpecific +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +asLargeInteger + | result | + result := (self positive + ifTrue: [LargePositiveInteger] + ifFalse: [LargeNegativeInteger]) + new: WordSize. + ^result from: self +! ! + +!SmallInteger methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asObject + ^self _asObject +! ! + +!SmallInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + index <= 0 ifTrue: [self error: 'non positive index']. + index > WordSize ifTrue: [^0]. + ^self _smallIntegerByteAt: index +! ! + +!SmallInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index put: anObject + ^self shouldNotImplement +! ! + +!SmallInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: index + index <= 0 ifTrue: [self error: 'non positive index']. + index > WordSize ifTrue: [^0]. + ^self _smallIntegerByteAt: index +! ! + +!SmallInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicHash + ^self +! ! + +!SmallInteger methodsFor: 'meta accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +behavior: aBehavior + self shouldNotImplement +! ! + +!SmallInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitAnd: anInteger + anInteger _isSmallInteger ifFalse: [^anInteger bitAnd: self]. + ^self _smiBitAnd: anInteger +! ! + +!SmallInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitAt: anInteger + anInteger < 1 ifTrue: [self error: 'non positive index']. + self = 0 ifTrue: [^0]. + ^super bitAt: anInteger +! ! + +!SmallInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitOr: anInteger + anInteger _isSmallInteger ifFalse: [^anInteger bitOr: self]. + ^self _smiBitOr: self +! ! + +!SmallInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitShift: anInteger + anInteger = 0 ifTrue: [^self]. + ^anInteger > 0 + ifTrue: [self bitShiftLeft: anInteger] + ifFalse: [self bitShiftRight: 0 - anInteger] +! ! + +!SmallInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitShiftLeft: anInteger + | result bits total bytes hi lo shift | + anInteger < (WordSize * 8 - 1) ifTrue: [ + result := self _bitShiftLeft: anInteger. + result ifNotNil: [^result]]. + self = 0 ifTrue: [^0]. + self < 0 ifTrue: [^(self negated bitShiftLeft: anInteger) negated]. + total := anInteger + self highBit. + bytes := total + 7 _bitShiftRight: 3. + bits := anInteger bitAnd: 7. + bits = 0 + ifTrue: [^LargeInteger + fromInteger: self + byteShiftLeft: bytes - self sizeInBytes]. + hi := self _bitShiftRight: 8 - bits. + lo := (self bitAnd: 0xFF) _bitShiftLeft: bits. + hi := hi bitOr: (lo at: 2). + lo := lo bitAnd: 0xFF. + hi = 0 ifTrue: [^LargeInteger fromInteger: lo byteShiftLeft: bytes - 1]. + shift := bytes - hi sizeInBytes. + result := LargeInteger fromInteger: hi byteShiftLeft: shift. + result at: shift put: lo. + ^result +! ! + +!SmallInteger methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitShiftRight: anInteger + ^anInteger <= (WordSize * 8 - 2) + ifTrue: [self _bitShiftRight: anInteger] + ifFalse: [self >= 0 ifTrue: [0] ifFalse: [-1]] +! ! + +!SmallInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitXor: anInteger + ^anInteger bitXor: self +! ! + +!SmallInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: anInteger + ^self at: anInteger +! ! + +!SmallInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: anInteger put: byte + ^self at: anInteger put: byte +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +gcd: anInteger + | n m | + n := self. + m := anInteger. + [n = 0] whileFalse: [n := m \\ (m := n)]. + ^m abs +! ! + +!SmallInteger methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^self +! ! + +!SmallInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashMultiply + ^self hashMultiply: 16r19660D +! ! + +!SmallInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashMultiply: aNumber + | low14a high14a low14b high14b | + (self < 162 and: [aNumber == 16r19660D]) ifTrue: [^self * 16r19660D]. + low14a := self bitAnd: 16r3FFF. + high14a := (self bitShift: -14) bitAnd: 16r3FFF. + low14b := aNumber bitAnd: 16r3FFF. + high14b := (aNumber bitShift: -14) bitAnd: 16r3FFF. + ^16r4000 * (low14b * high14a + (high14b * low14a) bitAnd: 16r3FFF) + + (low14b * low14a) + bitAnd: 16rFFFFFFF +! ! + +!SmallInteger methodsFor: 'bits' stamp: 'KenD 28/Jun/2026 13:27:38'! +highBit + self < 0 ifTrue: [^self error: 'not valid for negative numbers']. + ^(WordSize _bitShiftLeft: 3) - self _leadingZeroBitCount +! ! + +!SmallInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +highDigit + | n b | + n := self sizeInBytes. + b := self at: n. + b = 0 ifTrue: [^self at: n - 1]. + ^b +! ! + +!SmallInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +highWideDigit + | highest | + highest := self sizeInBytes. + (highest bitAnd: 1) = 1 ifTrue: [highest := highest + 1]. + ^((self at: highest) bitShift: 8) + (self at: highest - 1) +! ! + +!SmallInteger methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFixedObject + ^true +! ! + +!SmallInteger methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSmallInteger + ^true +! ! + +!SmallInteger methodsFor: 'bit operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +low32 + ^WordSize > 4 ifTrue: [self bitAnd: 0xFFFFFFFF] ifFalse: [self] +! ! + +!SmallInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +marshalOn: aStream + aStream _nextNativePut: self +! ! + +!SmallInteger methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +negated + self = Minimum ifTrue: [^Maximum + 1]. + ^super negated +! ! + +!SmallInteger methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + | abs divisor digit | + abs := self < 0 + ifTrue: [ + aStream nextPut: $-. + abs := 0 - self] + ifFalse: [self]. + divisor := 1. + [divisor > abs] whileFalse: [divisor := divisor * 10]. + [ + divisor := divisor // 10. + divisor > 1] + whileTrue: [ + digit := Character digitValue: abs // divisor. + aStream nextPut: digit. + abs := abs \\ divisor]. + digit := Character digitValue: abs. + aStream nextPut: digit +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +quo: aNumber + | result | + aNumber == 0 ifTrue: [^self zeroDivisorOn: #quo:]. + aNumber _isSmallInteger + ifTrue: [^self _quotientTowardZero: aNumber] + ifFalse: [ + result := self abs // aNumber abs. + ^self sign == aNumber sign ifTrue: [result] ifFalse: [0 - result]] +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +quoRem1: anInteger + ^{self // anInteger. self \\ anInteger} +! ! + +!SmallInteger methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +rem: aNumber + ^super rem: aNumber +! ! + +!SmallInteger methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:38'! +requireFinalization + ^self +! ! + +!SmallInteger methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^self = 0 + ifTrue: [1] + ifFalse: [WordSize - (self _leadingZeroBitCount _bitShiftRight: 3)] +! ! + +!SmallInteger methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +wideDigitAt: index + index <= 0 ifTrue: [self error: 'non positive index']. + ^(self bitShift: 1 - index * LargeInteger digitBits) + bitAnd: LargeInteger base - 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SmallInteger class' category: #Kernel! +SmallInteger class + instanceVariableNames: 'Maximum Minimum'! + +!SmallInteger class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBeDeleted + ^false +! ! + +!SmallInteger class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeConstants + Maximum := (1 bitShift: WordSize * 8 - 2) - 1. + Minimum := Maximum negated - 1 +! ! + +!SmallInteger class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +maximum + ^Maximum +! ! + +!SmallInteger class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:27:38'! +minimum + ^Minimum +! ! + + diff --git a/modules/Kernel/SmalltalkSession.Class.st b/modules/Kernel/SmalltalkSession.Class.st new file mode 100644 index 00000000..f8217d72 --- /dev/null +++ b/modules/Kernel/SmalltalkSession.Class.st @@ -0,0 +1,94 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #SmalltalkSession category: #Kernel! +Object subclass: #SmalltalkSession + instanceVariableNames: 'name username args resources finalizer' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +args + ^args +! ! + +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +args: anArray + args := anArray +! ! + +!SmalltalkSession methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026 13:27:38'! +closeExternalResources + resources do: [:object | object sessionShutdown] +! ! + +!SmalltalkSession methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026 13:27:38'! +ephemeronsDo: aBlock + resources ephemeronsDo: aBlock. + finalizer ephemeronsDo: aBlock. +! ! + +!SmalltalkSession methodsFor: 'shutdown' stamp: 'KenD 28/Jun/2026 13:27:38'! +exit: code + [self shutdown] ensure: [Kernel host exit: code] +! ! + +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +finalizer + ^finalizer +! ! + +!SmalltalkSession methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + name := 'egg session'. + finalizer := WeakIdentitySet new. + resources := WeakIdentitySet new +! ! + +!SmalltalkSession methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeFinalizationBlocks + finalizer finalizer: [:object | object finalize]. + resources finalizer: [:object | object finalize] +! ! + +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name + ^name +! ! + +!SmalltalkSession methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +rehashWeakRegistries + resources rehash. + finalizer rehash +! ! + +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +resourceRegistry + ^resources +! ! + +!SmalltalkSession methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026 13:27:38'! +startUp + self initializeFinalizationBlocks. + resources do: [:object | object sessionStartup] +! ! + +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +username + ^username +! ! + +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +username: aString + username := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SmalltalkSession class' category: #Kernel! +SmalltalkSession class + instanceVariableNames: ''! + + +SmalltalkSession initialize! + diff --git a/modules/Kernel/SmalltalkSystem.Class.st b/modules/Kernel/SmalltalkSystem.Class.st new file mode 100644 index 00000000..5367ee97 --- /dev/null +++ b/modules/Kernel/SmalltalkSystem.Class.st @@ -0,0 +1,391 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #SmalltalkSystem category: #Kernel! +Object subclass: #SmalltalkSystem + instanceVariableNames: 'globals eventHandlers registeredEvents eventDispatcher' + classVariableNames: 'Implementors Senders' + poolDictionaries: '' + category: 'Kernel'! +!SmalltalkSystem commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anAssociation + self ASSERT: Smalltalk !!== self. + ^globals add: anAssociation +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationAt: aSymbol + ^globals associationAt: aSymbol +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationAt: aSymbol ifAbsent: aBlock + ^globals associationAt: aSymbol ifAbsent: aBlock +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationClass + ^globals associationClass +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationsDo: aBlock + globals associationsDo: aBlock +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: aSymbol + ^globals at: aSymbol +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: aSymbol ifAbsent: aBlock + ^globals at: aSymbol ifAbsent: aBlock +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: aSymbol ifAbsentPut: aBlock + ^self at: aSymbol ifAbsent: [self at: aSymbol put: aBlock value] +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: aSymbol put: anObject + | key global | + key := aSymbol asSymbol. + global := globals at: key ifAbsent: nil. + global isClass ifTrue: [ + anObject == global ifTrue: [^self]. + global symbol == key + ifTrue: [^self error: 'Overriding classes is not allowed']]. + globals at: key put: anObject. + self justDefined: aSymbol. + ^anObject +! ! + +!SmalltalkSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAdd: anAssociation + globals basicAdd: anAssociation. + self justDefined: anAssociation key. + ^anAssociation +! ! + +!SmalltalkSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: aSymbol put: anObject + | assoc | + assoc := Association key: aSymbol value: anObject. + self basicAdd: assoc. + ^anObject +! ! + +!SmalltalkSystem methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicRemoveKey: key ifAbsent: aBlock + ^globals removeKey: key ifAbsent: aBlock +! ! + +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +beep + ^self operatingSystem beep +! ! + +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +bindEventTable: aDictionary to: anObject + aDictionary isNil + ifTrue: [eventHandlers removeKey: anObject ifAbsent: []] + ifFalse: [eventHandlers at: anObject put: aDictionary] +! ! + +!SmalltalkSystem methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canOpenBacktrace + ^true +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classNamed: aString + | name tag meta global | + name := aString. + tag := ' class'. + meta := aString endsWith: tag. + meta ifTrue: [name := name allButLast: tag size]. + global := self at: name asSymbol ifAbsent: [^nil]. + ^global isSpecies ifTrue: [meta ifTrue: [global class] ifFalse: [global]] +! ! + +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +collectGarbage + memory forceCompact +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +eventDispatcher + ^eventDispatcher +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +eventDispatcher: anEventDispatcher + eventDispatcher := anEventDispatcher +! ! + +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +eventTableFor: anObject + ^eventHandlers at: anObject ifAbsent: nil +! ! + +!SmalltalkSystem methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026 13:27:38'! +exit + session exit +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +finalizer + ^finalizer +! ! + +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +flushNativizedSends + ImageSegment bound do: [:s | + s overriddenMethods ifNotNil: [:overridden | + overridden + do: [:m | m isNativized ifTrue: [m currentVersion prepareForExecution]]; + do: [:m | SendSite flush: m selector]]]. + SendSite flush +! ! + +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +flushOverriddenSends + ImageSegment bound do: [:s | s flushOverriddenSends]. + SendSite flush +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +globals + ^globals +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +globals: aNamespace + globals := aNamespace +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasDebugger + ^false +! ! + +!SmalltalkSystem methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasDebuggerTool + ^false +! ! + +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +ignoreHalts: aBoolean + Halt ignoreSignals: aBoolean. + AssertionFailure ignoreSignals: aBoolean +! ! + +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +ignoreOSMessagesWhile: aBlock + ^eventDispatcher isNil + ifTrue: [aBlock value] + ifFalse: [aBlock evaluateAtomically] +! ! + +!SmalltalkSystem methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +includes: anObject + ^globals includes: anObject +! ! + +!SmalltalkSystem methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +includesKey: aSymbol + ^globals includesKey: aSymbol +! ! + +!SmalltalkSystem methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + eventHandlers := WeakIdentityDictionary new. + registeredEvents := WeakIdentityDictionary new +! ! + +!SmalltalkSystem methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBee + ^true +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyAtValue: anObject + ^globals keyAtValue: anObject +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +keys + ^globals keys +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +messageQueue + ^eventDispatcher messageQueue +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nameOfGlobal: anObject + ^globals keyAtValue: anObject +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nativizer + ^nativizer +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nativizer: anObject + nativizer := anObject +! ! + +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNamed: aString + ^NamedPrimitives at: aString ifAbsent: nil +! ! + +!SmalltalkSystem methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + self == Smalltalk + ifTrue: [aStream nextPutAll: 'Smalltalk'] + ifFalse: [super printOn: aStream] +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +processAllMessages + eventDispatcher processAllMessages +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +register: aSet for: aClass + registeredEvents at: aClass put: aSet +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +registeredEventsFor: aClass + ^registeredEvents at: aClass ifAbsent: nil +! ! + +!SmalltalkSystem methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +rehashWeakRegistries + eventHandlers rehash. + registeredEvents rehash +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeClass: aClass + aClass isDeleted ifTrue: [^self]. + self devenv forgetClass: aClass. + globals basicRemoveKey: aClass symbol ifAbsent: nil. + aClass class superclass isNil + ifFalse: [aClass class superclass removeSubclass: aClass class]. + aClass superclass isNil ifFalse: [aClass superclass removeSubclass: aClass]. + aClass beDeleted +! ! + +!SmalltalkSystem methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeKey: key + ^globals removeKey: key +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeKey: aSymbol from: aMethodDictionary ifAbsent: aBlock + | cm | + cm := aMethodDictionary at: aSymbol ifAbsent: [^aBlock value]. + self devenv forgetMethod: cm. + ^aMethodDictionary basicRemoveKey: aSymbol asSymbol ifAbsent: aBlock +! ! + +!SmalltalkSystem methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeKey: aSymbol ifAbsent: aBlock + | selector global | + selector := aSymbol asSymbol. + global := globals at: selector ifAbsent: [^aBlock value]. + (global isClass and: [global symbol == selector]) ifTrue: [ + global allInstances notEmpty + ifTrue: [^self error: 'The class being removed still has instances']. + global delete. + ^selector]. + ^globals basicRemoveKey: selector ifAbsent: aBlock +! ! + +!SmalltalkSystem methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:38'! +renameClass: aClass to: aSymbol + | symbol token assoc | + symbol := aSymbol asSymbol. + (globals includesKey: symbol) + ifTrue: [self error: 'the global ' , symbol , ' already exists']. + token := aClass symbol. + assoc := globals associationAt: token. + globals basicRemoveKey: token ifAbsent: nil. + assoc key: symbol. + globals basicAdd: assoc. + aClass name: symbol +! ! + +!SmalltalkSystem methodsFor: 'binding libraries' stamp: 'KenD 28/Jun/2026 13:27:38'! +segmentLoaded: anImageSegment + +! ! + +!SmalltalkSystem methodsFor: 'binding libraries' stamp: 'KenD 28/Jun/2026 13:27:38'! +segmentUnloaded: anImageSegment + +! ! + +!SmalltalkSystem methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: aBlock thenDo: anotherBlock + globals select: aBlock thenDo: anotherBlock +! ! + +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +showBacktraceOf: aProcess label: aString + | writer logger | + writer := '' writeStream. + aProcess + backtraceOn: writer + maxLevels: 100 + stopWhen: [:cm | cm isDoit] + filtered: false + arguments: false. + logger := self at: #Transcript ifAbsent: nil. + logger isNil + ifTrue: [session logError: writer contents] + ifFalse: [logger nextPutAll: aString; cr; nextPutAll: writer contents]. + aProcess isResumable ifTrue: [aProcess performDeferred: #resume] +! ! + +!SmalltalkSystem methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026 13:27:38'! +startUp + session startUp. + self ephemeronsDo: [:e | e activate]. + Float startUp. + memory startUp. + "platform startUp." +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +transcript + ^globals at: #Transcript +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +version + ^'0.1.1' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SmalltalkSystem class' category: #Kernel! +SmalltalkSystem class + instanceVariableNames: 'Implementors Senders'! + + +SmalltalkSystem initialize! + diff --git a/modules/Kernel/SortedCollection.Class.st b/modules/Kernel/SortedCollection.Class.st new file mode 100644 index 00000000..eabbda3e --- /dev/null +++ b/modules/Kernel/SortedCollection.Class.st @@ -0,0 +1,208 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #SortedCollection category: #Kernel! +OrderedCollection subclass: #SortedCollection + instanceVariableNames: 'sortBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!SortedCollection commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!SortedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anObject + | idx | + idx := self indexFor: anObject. + self add: anObject at: idx +! ! + +!SortedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +addAll: aCollection + aCollection size > (self size // 3) + ifTrue: [ + aCollection do: [:each | self addLast: each]. + self reSort] + ifFalse: [aCollection do: [:each | self add: each]]. + ^aCollection +! ! + +!SortedCollection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asOrderedCollection + ^OrderedCollection withAll: self +! ! + +!SortedCollection methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asSortedCollection + ^self +! ! + +!SortedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: anObject + ^self shouldNotImplement +! ! + +!SortedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +blockForCopy: copy + (sortBlock isMessage and: [sortBlock receiver == self]) + ifTrue: [^sortBlock copy receiver: copy]. + ^sortBlock +! ! + +!SortedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +copyFrom: startIndex to: endIndex + | copy block | + copy := super copyFrom: startIndex to: endIndex. + block := self blockForCopy: copy. + copy sortBlock: block. + ^copy +! ! + +!SortedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + | copy block | + copy := self species new. + block := self blockForCopy: copy. + copy sortBlock: block. + self do: [:element | copy add: element copy]. + ^copy +! ! + +!SortedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexFor: newObject + | index low high sorter | + low := start. + high := end. + sorter := sortBlock ifNil: [self]. + [ + index := high + low // 2. + low > high] + whileFalse: [ + (sorter value: (contents at: index) value: newObject) + ifTrue: [low := index + 1] + ifFalse: [high := index - 1]]. + ^low - start + 1 +! ! + +!SortedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reSort + self sort: start to: end +! ! + +!SortedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: aBlock + | collection block | + collection := self species new. + block := self blockForCopy: collection. + collection sortBlock: block. + self + do: [:element | (aBlock evaluateWith: element) + ifTrue: [collection add: element]]. + ^collection +! ! + +!SortedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +select: n satisfying: aBlock + | collection block | + collection := super select: n satisfying: aBlock. + block := self blockForCopy: collection. + collection sortBlock: block. + ^collection +! ! + +!SortedCollection methodsFor: 'sorting' stamp: 'KenD 28/Jun/2026 13:27:38'! +sort: left to: right + | i j sorter | + i := left. + j := right. + sorter := sortBlock ifNil: [self]. + [| remaining finished swapper middle temp last | + remaining := j - i. + (finished := remaining <= 1) + ifTrue: [ + remaining = 1 ifTrue: [ + remaining := contents at: j. + swapper := contents at: i. + (sorter value: remaining value: swapper) ifTrue: [ + contents + at: i put: remaining; + at: j put: swapper]]] + ifFalse: [ + middle := i + j // 2. + temp := contents at: middle. + contents at: middle put: (contents at: i). + remaining := last := i. + [ + remaining := remaining + 1. + (sorter value: (contents at: remaining) value: temp) ifTrue: [ + last := last + 1. + last = remaining ifFalse: [ + swapper := contents at: remaining. + contents + at: remaining put: (contents at: last); + at: last put: swapper]]. + remaining < j] whileTrue. + contents + at: i put: (contents at: last); + at: last put: temp. + middle < last + ifTrue: [ + self sort: last + 1 to: j. + j := last - 1] + ifFalse: [ + self sort: i to: last - 1. + i := last + 1]]. + finished] whileFalse +! ! + +!SortedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +sortBlock + ^sortBlock +! ! + +!SortedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sortBlock: aBlock + sortBlock := aBlock. + self reSort +! ! + +!SortedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sortBy: criteria + sortBlock := criteria. + self reSort +! ! + +!SortedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: object1 value: object2 + ^object1 <= object2 +! ! + +!SortedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withIndexCollect: aBlock + ^self withIndexCollect: aBlock in: (OrderedCollection new: self size) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SortedCollection class' category: #Kernel! +SortedCollection class + instanceVariableNames: ''! + +!SortedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +sortBlock: aBlock + | instance | + instance := super new: 10. + ^instance sortBlock: aBlock +! ! + +!SortedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: aCollection sortingBy: aBlock + | collection | + collection := self new: aCollection size. + collection sortBlock: aBlock; addAll: aCollection. + ^collection +! ! + + diff --git a/modules/Kernel/Species.Class.st b/modules/Kernel/Species.Class.st new file mode 100644 index 00000000..fe57f546 --- /dev/null +++ b/modules/Kernel/Species.Class.st @@ -0,0 +1,553 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Species category: #Kernel! +Object subclass: #Species + instanceVariableNames: 'superclass instanceBehavior format organization instanceVariables' + classVariableNames: 'Flags' + poolDictionaries: '' + category: 'Kernel'! +!Species commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +_instancesAreArrayed + ^format & Variable = Variable +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +_instancesAreFixed + ^format & Variable = 0 +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +_instancesHavePointers + ^format & Pointers !!= 0 +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>> aSelector + ^self compiledMethodAt: aSelector +! ! + +!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:38'! +addSelector: aSymbol withMethod: aCompiledMethod + | selector | + selector := aSymbol asSymbol. + self methodDictionary at: selector put: aCompiledMethod. + self organization notNil ifTrue: [self organization classify: selector] +! ! + +!Species methodsFor: 'hierarchy' stamp: 'KenD 28/Jun/2026 13:27:38'! +addSubclass: aClass + | copy | + (self subclasses includes: aClass) ifTrue: [^self]. + copy := self subclasses copyWith: aClass. + self subclasses: copy. + aClass superclass: self +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allClassVarNames + ^(self withAllSuperclasses reversed gather: [:cls | cls classVarNames]) asArray +! ! + +!Species methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +allInstances + ^Kernel memory allInstancesOf: self +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allInstVarNames + ^(self withAllSuperclasses reversed gather: [:class | class instVarNames]) asArray +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSubclasses + | all | + all := OrderedCollection new. + self allSubclassesDo: [:cls | all add: cls]. + ^all +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSubclassesDo: aBlock + self subclassesDo: [:class | + aBlock value: class. + class allSubclassesDo: aBlock] +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSubinstances + | subinstances | + subinstances := OrderedCollection new. + [ + self + withAllSubclassesDo: [:cls | subinstances + addAll: cls allExistingInstances]] + evaluateAtomically. + ^subinstances asArray +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSubspecies + | all | + all := OrderedCollection new. + self allSubspeciesDo: [:cls | all add: cls]. + ^all +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSubspeciesDo: aBlock + self subspeciesDo: [:class | + aBlock value: class. + class allSubspeciesDo: aBlock] +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSuperclasses + | superclasses | + superclasses := OrderedCollection new. + self allSuperclassesDo: [:s | superclasses add: s]. + ^superclasses +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSuperclassesDo: aBlock + superclass isNil ifTrue: [^self]. + aBlock value: superclass. + superclass allSuperclassesDo: aBlock +! ! + +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew + ^self errorVMSpecific +! ! + +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew: anInteger + ^self errorVMSpecific +! ! + +!Species methodsFor: 'flags' stamp: 'KenD 28/Jun/2026 13:27:38'! +bePointers + format := Pointers + self instSize +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +browse + Smalltalk browsingTools browse: self +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +buildBehavior + | behavior | + behavior := Behavior with: self methodDictionary copy. + superclass ifNotNil: [behavior next: superclass instanceBehavior]. + instanceBehavior := behavior +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canUnderstand: aSymbol + ^instanceBehavior implements: aSymbol +! ! + +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! +categories + ^self organization notNil + ifTrue: [self organization categoriesOn: self] + ifFalse: [#()] +! ! + +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! +categorizedSelectors + ^self organization notNil + ifTrue: [self organization allSelectors] + ifFalse: [#()] +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +categoryFor: selector + | category | + self organization notNil ifTrue: [ + category := self organization categoryFor: selector. + category notNil ifTrue: [^category]]. + ^ClassOrganizer default +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +classImplementing: aSymbol + (self methodDictionary includesKey: aSymbol) ifTrue: [^self]. + ^self allSuperclasses + detect: [:class | class includesSelector: aSymbol] + ifNone: [] +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVariableAssociationAt: aString + | c assoc | + c := self. + [ + c isNil ifTrue: [^nil]. + c classVariables notNil and: [ + assoc := c classVariables associationAt: aString ifAbsent: nil. + assoc notNil]] + whileFalse: [c := c superclass]. + ^assoc +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVariableString + | stream | + stream := '' writeStream. + self classVarNames asSortedCollection + do: [:cvar | stream nextPutAll: cvar] + separatedBy: [stream space]. + ^stream contents +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +compiledMethodAt: aSymbol + ^self methodDictionary at: aSymbol ifAbsent: nil +! ! + +!Species methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + ^self +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +depth + " + Object depth + SmallInteger depth 4 + " + | depth ancestor | + depth := 0. + ancestor := self superclass. + ancestor notNil ifTrue: [depth := ancestor depth + 1]. + ^depth +! ! + +!Species methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +errorNotIndexable + ^self error: 'Instances of ' , self name , ' are not indexable' +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +fillFrom: aClass + | ivars | + self == aClass ifTrue: [^self]. + format := aClass format. + ivars := aClass instVarNames. + instanceVariables := ivars notEmpty ifTrue: [ivars] +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +format + ^format +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +format: anInteger + format := anInteger +! ! + +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasUnclassifiedSelectors + ^self categorizedSelectors size < self methodDictionary size +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +includesSelector: aSymbol + ^self methodDictionary includesKey: aSymbol +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +inheritsFrom: aClass + | class | + class := self. + [class == nil] whileFalse: [ + class == aClass ifTrue: [^true]. + class := class superclass]. + ^false +! ! + +!Species methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeOrganization + self + organization: (ClassOrganizer new classifyAll: self selectors under: nil) +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instanceBehavior + ^instanceBehavior +! ! + +!Species methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +instanceBehavior: aBehavior + instanceBehavior := aBehavior +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instancesAreArrayed + ^self _instancesAreArrayed +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instancesHavePointers + ^self _instancesHavePointers +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +instanceVariableString + ^String streamContents: [:strm | + self instVarNames + do: [:ivar | strm nextPutAll: ivar] + separatedBy: [strm space]] +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +instSize + ^format & 16r7F +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +instVarNames + instanceVariables isNil ifTrue: [^#()]. + instanceVariables isArray ifTrue: [^instanceVariables]. + ^instanceVariables substrings +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instVarNames: aCollection + instanceVariables := aCollection isEmpty + ifFalse: [ + self isBytes ifTrue: [^self error: 'byte objects cannot have named instance variables']. + aCollection asArray]. + self updateInstSize; allSubspeciesDo: [:class | class updateInstSize] +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBytes + ^self _instancesHavePointers not +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCategorized + ^self organization notNil +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSpecies + ^true +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isVariable + ^self _instancesAreArrayed +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +kindOfSubclass + self _instancesAreFixed ifTrue: [^'subclass:']. + self isBytes ifTrue: [^'variableByteSubclass:']. + self _instancesHavePointers ifTrue: [^'variableSubclass:']. + self error: 'invalid type of subclass' +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodDictionary + ^instanceBehavior methods +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodsReadingInstVar: aString + | methods index | + methods := OrderedCollection new. + index := self indexOfSlot: aString. + index = 0 ifTrue: [^methods]. + self methodDictionary + select: [:cm | cm usesInstanceVariable: index] + thenDo: [:cm | methods add: cm]. + ^methods +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodsReferencingClassVar: aString + | methods assoc | + methods := OrderedCollection new. + assoc := self classVariableAssociationAt: aString. + assoc isNil ifTrue: [^methods]. + self instanceClass methodDictionary + & self instanceClass class methodDictionary + select: [:cm | cm referencesAssociation: assoc] + thenDo: [:cm | methods add: cm]. + ^methods +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodsReferencingInstVar: aString + | methods index | + methods := OrderedCollection new. + index := self indexOfSlot: aString. + index = 0 ifTrue: [^methods]. + self methodDictionary + select: [:cm | cm referencesInstanceVariable: index] + thenDo: [:cm | methods add: cm]. + ^methods +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodsWritingInstVar: aString + | methods index | + methods := OrderedCollection new. + index := self indexOfSlot: aString. + index = 0 ifTrue: [^methods]. + self methodDictionary + select: [:cm | cm assignsInstanceVariable: index] + thenDo: [:cm | methods add: cm]. + ^methods +! ! + +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self errorVMSpecific +! ! + +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self errorVMSpecific +! ! + +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! +organization + organization isNil ifTrue: [self initializeOrganization]. + ^organization +! ! + +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! +organization: aClassOrganizer + organization := aClassOrganizer +! ! + +!Species methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNewBytes: size + ^self errorVMSpecific +! ! + +!Species methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: self name +! ! + +!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeSelector: aSymbol + self methodDictionary removeKey: aSymbol ifAbsent: []. + self organization notNil ifTrue: [self organization remove: aSymbol] +! ! + +!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeSubclass: aClass + " + do nothing + " + +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +selectors + ^self methodDictionary keys +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +selectorsInCategory: aSymbol + ^self organization selectorsFor: aSymbol +! ! + +!Species methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +shallowCopy + ^self +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +shouldBeHidden: aSymbol + ^false +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +superclass + ^superclass +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +superclass: aClass + superclass := aClass +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +timestamp + ^organization notNil ifTrue: [organization timestamp] +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +updateClassifications + organization notNil ifTrue: [organization updateOn: self] +! ! + +!Species methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +updateInstSize + | size | + size := superclass isNil ifTrue: [0] ifFalse: [superclass instSize]. + format := format - self instSize + size + self instVarNames size +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAllSubclasses + ^OrderedCollection with: self withAll: self allSubclasses +! ! + +!Species methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAllSubclassesDo: aBlock + aBlock evaluateWith: self. + self allSubclassesDo: aBlock +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAllSubspecies + ^OrderedCollection with: self withAll: self allSubspecies +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAllSuperclasses + ^OrderedCollection with: self withAll: self allSuperclasses +! ! + +!Species methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAllSuperclassesDo: aBlock + aBlock evaluateWith: self. + self allSuperclassesDo: aBlock +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Species class' category: #Kernel! +Species class + instanceVariableNames: 'Flags'! + +!Species class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeFormatFlags + Flags := self addNamespace. + Flags + at: #Variable put: 16r2000; + at: #Pointers put: 16r4000 +! ! + +!Species class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxInstVarCount + ^16r7F +! ! + + diff --git a/modules/Kernel/StackOverflow.Class.st b/modules/Kernel/StackOverflow.Class.st new file mode 100644 index 00000000..55788b4d --- /dev/null +++ b/modules/Kernel/StackOverflow.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #StackOverflow category: #Kernel! +Error subclass: #StackOverflow + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!StackOverflow commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StackOverflow methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultDescription + ^'Stack overflow' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'StackOverflow class' category: #Kernel! +StackOverflow class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/StarToken.Class.st b/modules/Kernel/StarToken.Class.st new file mode 100644 index 00000000..e56d9b48 --- /dev/null +++ b/modules/Kernel/StarToken.Class.st @@ -0,0 +1,54 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #StarToken category: #Kernel! +Object subclass: #StarToken + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!StarToken commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchFirstAfterStartOn: aMatchAlgorithm + aMatchAlgorithm matchFirstStar +! ! + +!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchFirstOn: aMatchAlgorithm + aMatchAlgorithm matchFirstStar +! ! + +!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchLastOn: aMatchAlgorithm + " + do nothing + " + +! ! + +!StarToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPut: $* +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'StarToken class' category: #Kernel! +StarToken class + instanceVariableNames: ''! + +!StarToken class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +current + ^current +! ! + +!StarToken class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeCurrent + current := self new +! ! + + diff --git a/modules/Kernel/Stream.Class.st b/modules/Kernel/Stream.Class.st new file mode 100644 index 00000000..6649c236 --- /dev/null +++ b/modules/Kernel/Stream.Class.st @@ -0,0 +1,99 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Stream category: #Kernel! +Object subclass: #Stream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Stream commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Stream methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asStream + ^self +! ! + +!Stream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atEnd + self shouldNotImplement +! ! + +!Stream methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +close + +! ! + +!Stream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +collectorClass + ^self shouldNotImplement +! ! + +!Stream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +eol + ^String crlf +! ! + +!Stream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isStream + ^true +! ! + +!Stream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +position + self shouldNotImplement +! ! + +!Stream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +position: anInteger + self shouldNotImplement +! ! + +!Stream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +reset + self position: 0 +! ! + +!Stream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +setToEnd + self position: self size +! ! + +!Stream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeToEnd + ^self size - self position +! ! + +!Stream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +skip + self skip: 1 +! ! + +!Stream methodsFor: 'positioning' stamp: 'KenD 28/Jun/2026 13:27:38'! +skip: n + | p | + p := self position + n min: self size. + p := p max: 0. + self position: p +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Stream class' category: #Kernel! +Stream class + instanceVariableNames: ''! + +!Stream class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializePools + self addNamespace: Character namedCharacters +! ! + +!Stream class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aCollection + ^self new on: aCollection +! ! + + diff --git a/modules/Kernel/Stretch.Class.st b/modules/Kernel/Stretch.Class.st new file mode 100644 index 00000000..d36d90a1 --- /dev/null +++ b/modules/Kernel/Stretch.Class.st @@ -0,0 +1,134 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Stretch category: #Kernel! +Object subclass: #Stretch + instanceVariableNames: 'start end' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Stretch commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- delta + ^self + delta negated +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +// anInteger + ^start // anInteger thru: end // anInteger +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ delta + delta isInteger ifTrue: [^start + delta thru: end + delta]. + delta isPoint ifTrue: [^start + delta x thru: end + delta y]. + ^start + delta start thru: end + delta end +! ! + +!Stretch methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aStretch + self class == aStretch class ifFalse: [^false]. + ^start = aStretch start and: [end = aStretch end] +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +center + ^start + end // 2 +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +down: anInteger + ^start thru: end + anInteger +! ! + +!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +end + ^end +! ! + +!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +end: anInteger + end := anInteger +! ! + +!Stretch methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^start hashWith: end +! ! + +!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +includes: anInteger + ^anInteger between: start and: end +! ! + +!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +intersects: aStretch + self isEmpty ifTrue: [^false]. + (aStretch includes: start) ifTrue: [^true]. + ^aStretch includes: end +! ! + +!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmpty + ^end < start +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +length + ^end - start + 1 +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +max + ^start max: end +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +min + ^start min: end +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +negated + ^start negated thru: end negated +! ! + +!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +notEmpty + ^start <= end +! ! + +!Stretch methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream + nextPutAll: start asString; + nextPutAll: ' thru: '; + nextPutAll: end asString +! ! + +!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +start + ^start +! ! + +!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +start: anInteger + start := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Stretch class' category: #Kernel! +Stretch class + instanceVariableNames: ''! + +!Stretch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +from: start thru: end + ^self new start: start; end: end +! ! + + diff --git a/modules/Kernel/String.Class.st b/modules/Kernel/String.Class.st new file mode 100644 index 00000000..ae286e82 --- /dev/null +++ b/modules/Kernel/String.Class.st @@ -0,0 +1,747 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #String category: #Kernel! +CharacterArray subclass: #String + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!String commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!String methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +, aString + aString isString ifFalse: [^super , aString]. + self isWide = aString isWide ifTrue: [^super , aString]. + ^self asWideString , aString asWideString +! ! + +!String methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aString + | n | + (self equals: aString) ifTrue: [^true]. + aString isSymbol ifTrue: [^false]. + aString isString ifFalse: [^false]. + n := self size. + n = aString size ifFalse: [^false]. + 1 to: n do: [:i | (self codeAt: i) = (aString codeAt: i) ifFalse: [^false]]. + ^true +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +ansiz + ^Ansi current parameterFrom: self +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asByteArray + | array | + array := ByteArray new: self sizeInBytes. + ^array + replaceBytesFrom: 1 + to: array size + with: self + startingAt: 1 +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asParameter + self ASSERT: false. + ^self +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asSymbol + ^Symbol intern: self +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asWideSymbol + ^WideSymbol intern: self +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger < self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^self characterAtValid: anInteger +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: aCharacter + ^self basicAt: anInteger put: aCharacter +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index putCode: codePoint + self byteAt: index put: codePoint +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: anInteger + ^self characterAtValid: anInteger +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger < self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^self characterAtValid: anInteger +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger put: aCharacter + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger < self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + aCharacter isCharacter + ifFalse: [^self + error: self class name , ' can''t hold ' , aCharacter class name]. + aCharacter isByteCharacter + ifFalse: [^self + error: 'Byte strings cannot hold non-latin1 characters']. + ^self _byteAt: anInteger put: aCharacter asInteger +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicSize + ^self _size - 1 +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: anInteger + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger < self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^self _byteAt: anInteger +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: position put: asciiValue + position _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= position and: [position < self _size]) + ifFalse: [^self outOfBoundsIndex: position]. + (0 <= asciiValue and: [asciiValue < 256]) + ifFalse: [^self error: 'invalid character']. + ^self _byteAt: position put: asciiValue +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +bytes + | array | + array := ByteArray new: self _size. + ^array + replaceBytesFrom: 1 + to: self sizeInBytes + with: self + startingAt: 1 +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterSize + ^1 +! ! + +!String methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +eol + | n code | + n := self size. + n = 0 ifTrue: [^nil]. + code := self codeAt: n. + code = 13 ifTrue: [^String with: Cr]. + code = 10 ifTrue: [ + ^n = 1 ifTrue: [String with: Lf] ifFalse: [ + (self codeAt: n - 1) = 13 + ifTrue: [String with: Cr with: Lf] + ifFalse: [String with: Lf]]]. + 1 to: n - 1 do: [:i | + code := self codeAt: i. + code = 13 ifTrue: [ + ^(self codeAt: i + 1) = 10 + ifTrue: [String with: Cr with: Lf] + ifFalse: [String with: Cr]]. + code = 10 ifTrue: [^String with: Lf]]. + ^nil +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +existingSymbol + ^Symbol findInterned: self +! ! + +!String methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +goodHash + | hash | + hash := self size. + self + do: [:char | hash := (hash * 16r19660D bitAnd: 16rFFFFFFF) + bitXor: char asInteger]. + ^hash +! ! + +!String methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOf: anObject between: start and: end ifAbsent: aBlock + | index cp | + self characterSize = 1 + ifFalse: [^super + indexOf: anObject + between: start + and: end + ifAbsent: aBlock]. + cp := anObject codePoint. + index := start. + [index <= end] whileTrue: [ + (self byteAt: index) = cp ifTrue: [^index]. + index := index + 1]. + ^aBlock value +! ! + +!String methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfString: aString from: start to: stop td1: anArray + | m k | + m := aString size. + m = 0 ifTrue: [^0]. + k := start. + [k + m - 1 <= stop] whileTrue: [| i byte delta | + i := 1. + [i <= m and: [(aString at: i) = (self at: k + i - 1)]] + whileTrue: [i := i + 1]. + i > m ifTrue: [^k]. + k + m > stop ifTrue: [^0]. + byte := self byteAt: k + m. + delta := (anArray at: byte + 1) ifNil: [m + 1]. + k := k + delta]. + ^0 +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +length + ^self size +! ! + +!String methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +normalizeToC + " + do nothing + " + +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +nullTerminated + ^self class withAll: self with: Character null +! ! + +!String methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveReplaceFrom: start to: stop withObject: aCharacter + self checkCharacter: aCharacter. + aCharacter isByteCharacter + ifFalse: [self error: 'Strings cannot hold non-latin1 characters']. + start to: stop do: [:i | self at: i put: aCharacter]. + ^aCharacter + +! ! + +!String methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPut: $'. + self do: [:char | + aStream nextPut: char. + char = $' ifTrue: [aStream nextPut: char]]. + aStream nextPut: $' +! ! + +!String methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printUTF8ChunkOn: aStream from: anInteger + | token encoder lf | + token := $!! asInteger. + encoder := UTF8 current. + lf := aStream eol = String crlf. + anInteger to: self size do: [:i | | char | + char := self at: i. + encoder encode: char on: aStream. + char = $!! + ifTrue: [aStream nextBytePut: token] + ifFalse: [(lf and: [char = Cr]) ifTrue: [aStream + nextBytePut: Lf asInteger]]]. + aStream nextBytePut: token +! ! + +!String methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFirst: count with: aCollection + ^self replaceFrom: 1 to: count with: aCollection startingAt: 1 +! ! + +!String methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop with: aString startingAt: position + aString hasBytes + ifTrue: [self + replaceBytesFrom: start + to: stop + with: aString + startingAt: position] + ifFalse: [super + replaceFrom: start + to: stop + with: aString + startingAt: position] +! ! + +!String methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop withObject: aCharacter + start > 0 ifFalse: [ + self + error: 'Invalid argument in ' , self storeString + , '>>#replaceFrom:to:withObject:']. + ^self primitiveReplaceFrom: start to: stop withObject: aCharacter +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self _size - 1 +! ! + +!String methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^self size +! ! + +!String methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +td1 + " + Sunday Algorithm + ShellDLL current openWebPage: 'http://www.cin.ufpe.br/~paguso/courses/if767/bib/Sunday_1990.pdf' + " + | m td1 | + m := self size. + td1 := Array new: 256. + m to: 1 by: -1 do: [:i | | byte j | + byte := self byteAt: i. + j := byte + 1. + (td1 at: j) isNil ifTrue: [td1 at: j put: m - i + 1]]. + ^td1 +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf16 + ^UTF16 current encode: self +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf16z + ^UTF16 current parameterFrom: self +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf8 + " + (WideString fromBytes: #[16r91 16r21]) utf8 + " + ^self utf8z: false +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf8Bytes + ^self utf8 +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf8z + " + (WideString fromBytes: #[16r91 16r21]) utf8z + " + ^self utf8z: true +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf8z: aBoolean + ^aBoolean + ifTrue: [UTF8 current parameterFrom: self] + ifFalse: [UTF8 current encode: self] +! ! + +!String methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +withCrLf + | index char | + index := self indexOf: Cr. + index = 0 ifTrue: [^self]. + char := self at: index + 1 ifAbsent: [^self copyWith: Lf]. + char = Lf ifTrue: [^self]. + ^self replaceAll: String cr with: String crlf +! ! + +!String methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +withoutBlanks + ^self reject: [:c | c = Space] +! ! + +!String methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +writeStream + ^WriteStringStream on: self +! ! + +!String methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +zapLfs + ^self reject: [:c | c isLf] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'String class' category: #Kernel! +String class + instanceVariableNames: ''! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew: anInteger + ^self primitiveNewBytes: anInteger + 1 +! ! + +!String class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +cr + ^self with: Cr +! ! + +!String class methodsFor: 'named characters' stamp: 'KenD 28/Jun/2026 13:27:38'! +crlf + ^self with: Cr with: Lf +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromBytes: aByteArray + | n string | + n := aByteArray sizeInBytes. + string := self basicNew: n. + ^string + replaceBytesFrom: 1 + to: n + with: aByteArray + startingAt: 1 +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromUTF8: aByteArray + ^(aByteArray conform: [:byte | byte asInteger < 128]) + ifTrue: [String fromBytes: aByteArray] + ifFalse: [UTF8 current decode: aByteArray] +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self new: 0 +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self primitiveNewBytes: anInteger + 1 +! ! + +!String class methodsFor: 'gs' stamp: 'KenD 28/Jun/2026 13:27:38'! +newFrom: aByteArray + | string | + string := self new: aByteArray size. + ^string replaceFirst: aByteArray size with: aByteArray +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +readFrom: aStream + | writer | + writer := (self new: 50) writeStream. + aStream upTo: $'. + [ + writer nextPutAll: (aStream upTo: $'). + aStream peek == $'] + whileTrue: [writer nextPut: aStream next]. + ^writer contents +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aCharacter + self == String ifFalse: [^super with: aCharacter]. + aCharacter isByteCharacter ifTrue: [^super with: aCharacter]. + ^WideString with: aCharacter +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: ch1 with: ch2 + self == String ifFalse: [^super with: ch1 with: ch2]. + ch1 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2]. + ch2 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2]. + ^super with: ch1 with: ch2 +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: ch1 with: ch2 with: ch3 + self == String ifFalse: [^super with: ch1 with: ch2 with: ch3]. + ch1 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2 with: ch3]. + ch2 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2 with: ch3]. + ch3 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2 with: ch3]. + ^super with: ch1 with: ch2 with: ch3 +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: ch1 with: ch2 with: ch3 with: ch4 + self == String ifFalse: [^super with: ch1 with: ch2 with: ch3 with: ch4]. + ch1 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2 with: ch3 with: ch4]. + ch2 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2 with: ch3 with: ch4]. + ch3 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2 with: ch3 with: ch4]. + ch4 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2 with: ch3 with: ch4]. + ^super with: ch1 with: ch2 with: ch3 with: ch4 +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: ch1 with: ch2 with: ch3 with: ch4 with: ch5 + self == String ifFalse: [ + ^super + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5]. + ch1 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5]. + ch2 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5]. + ch3 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5]. + ch4 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5]. + ch5 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5]. + ^super + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: ch1 with: ch2 with: ch3 with: ch4 with: ch5 with: ch6 + self == String ifFalse: [ + ^super + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6]. + ch1 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6]. + ch2 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6]. + ch3 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6]. + ch4 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6]. + ch5 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6]. + ch6 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6]. + ^super + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6 +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: ch1 with: ch2 with: ch3 with: ch4 with: ch5 with: ch6 with: ch7 + self == String ifFalse: [ + ^super + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6 + with: ch7]. + ch1 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6 + with: ch7]. + ch2 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6 + with: ch7]. + ch3 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6 + with: ch7]. + ch4 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6 + with: ch7]. + ch5 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6 + with: ch7]. + ch6 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6 + with: ch7]. + ch7 isByteCharacter ifFalse: [ + ^WideString + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6 + with: ch7]. + ^super + with: ch1 + with: ch2 + with: ch3 + with: ch4 + with: ch5 + with: ch6 + with: ch7 +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: ch1 with: ch2 withAll: collection + self == String ifFalse: [^super with: ch1 with: ch2 withAll: collection]. + ch1 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2 withAll: collection]. + ch2 isByteCharacter ifFalse: [^WideString with: ch1 with: ch2 withAll: collection]. + (collection conform: [:ch | ch isByteCharacter]) + ifFalse: [^WideString with: ch1 with: ch2 withAll: collection]. + ^super with: ch1 with: ch2 withAll: collection +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +with: aCharacter withAll: aCollection + self == String ifFalse: [^super with: aCharacter withAll: aCollection]. + aCharacter isByteCharacter + ifFalse: [^WideString with: aCharacter withAll: aCollection]. + (aCollection conform: [:ch | ch isByteCharacter]) + ifFalse: [^WideString with: aCharacter withAll: aCollection]. + ^super with: aCharacter withAll: aCollection +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: aCollection + self == String ifFalse: [^super withAll: aCollection]. + (aCollection conform: [:ch | ch isByteCharacter]) + ifFalse: [^WideString withAll: aCollection]. + ^super withAll: aCollection +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: aCollection with: aCharacter + self == String ifFalse: [^super withAll: aCollection with: aCharacter]. + aCharacter isByteCharacter + ifFalse: [^WideString withAll: aCollection with: aCharacter]. + (aCollection conform: [:ch | ch isByteCharacter]) + ifFalse: [^WideString withAll: aCollection with: aCharacter]. + ^super withAll: aCollection with: aCharacter +! ! + +!String class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAll: collection with: ch1 with: ch2 + self == String ifFalse: [^super withAll: collection with: ch1 with: ch2]. + ch1 isByteCharacter ifFalse: [^WideString withAll: collection with: ch1 with: ch2]. + ch2 isByteCharacter ifFalse: [^WideString withAll: collection with: ch1 with: ch2]. + (collection conform: [:ch | ch isByteCharacter]) + ifFalse: [^WideString withAll: collection with: ch1 with: ch2]. + ^super withAll: collection with: ch1 with: ch2 +! ! + + diff --git a/modules/Kernel/StringPattern.Class.st b/modules/Kernel/StringPattern.Class.st new file mode 100644 index 00000000..f90f85d4 --- /dev/null +++ b/modules/Kernel/StringPattern.Class.st @@ -0,0 +1,112 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #StringPattern category: #Kernel! +Object subclass: #StringPattern + instanceVariableNames: 'stream tokens' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!StringPattern commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:38'! +addStar + stream atEnd ifTrue: [^self]. + tokens add: StarToken current. + stream next. + [stream peek ifNil: [^self] ifNotNil: [:c | c isAsterisk]] + whileTrue: [stream next] +! ! + +!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:38'! +addToken + | star pos end token | + star := false. + pos := stream position + 1. + [stream atEnd or: [star := stream next isAsterisk]] whileFalse. + star ifTrue: [stream skip: -1]. + end := stream position. + pos <= end ifTrue: [ + token := MatchToken on: stream collection from: pos to: end. + tokens add: token] +! ! + +!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +input + ^stream contents +! ! + +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +match: aString + ^self match: aString index: 1 +! ! + +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +match: aString ifAbsent: aBlock + ^self match: aString index: 1 ifAbsent: aBlock +! ! + +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +match: aString index: anInteger + ^self match: aString index: anInteger ifAbsent: nil +! ! + +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +match: aString index: anInteger ifAbsent: aBlock + | algorithm | + algorithm := MatchAlgorithm new + pattern: self; + string: aString; + index: anInteger. + algorithm run. + algorithm hasMatched ifTrue: [^algorithm matchRange]. + ^aBlock notNil ifTrue: [ + aBlock arity = 0 + ifTrue: [aBlock value] + ifFalse: [aBlock evaluateWith: algorithm failure]] +! ! + +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +matches: aString + | range | + range := self match: aString. + ^range notNil and: [range x = 1 and: [range y = aString size]] +! ! + +!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aString + stream := aString readStream. + tokens := OrderedCollection new. + self scan +! ! + +!StringPattern methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + tokens do: [:t | t printOn: aStream] +! ! + +!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:38'! +scan + [stream atEnd] whileFalse: [self addToken; addStar] +! ! + +!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tokens + ^tokens copy +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'StringPattern class' category: #Kernel! +StringPattern class + instanceVariableNames: ''! + +!StringPattern class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aString + ^self new on: aString +! ! + + diff --git a/modules/Kernel/SuspendedProcess.Class.st b/modules/Kernel/SuspendedProcess.Class.st new file mode 100644 index 00000000..a1a7ae74 --- /dev/null +++ b/modules/Kernel/SuspendedProcess.Class.st @@ -0,0 +1,71 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #SuspendedProcess category: #Kernel! +Process subclass: #SuspendedProcess + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!SuspendedProcess commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!SuspendedProcess methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +beActive + self changeClassTo: ActiveProcess +! ! + +!SuspendedProcess methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +drop + " + We are not active, just remove ourselves from the scheduler queues + " + + Processor unschedule: self +! ! + +!SuspendedProcess methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluating: aMessageSend + | method | + method := ActiveProcess >> #launch:. + method prepareForExecution. + topContext := LaunchContext new + receiver: self; + code: method executableCode method: method; + arguments: { aMessageSend }. +! ! + +!SuspendedProcess methodsFor: 'executing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prepareForExecution + self isReified ifFalse: [^self]. + nativeStack ifNil: [self initializeStack]. + nativeStack fillFrom: topContext. + topContext := nil +! ! + +!SuspendedProcess methodsFor: 'scheduling' stamp: 'KenD 28/Jun/2026 13:27:38'! +takeControl + | current | + self prepareForExecution. + current := Processor activeProcess. + current beInactive. + Processor activeProcess: self beActive. + current nativeStack contextSwitchTo: nativeStack +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SuspendedProcess class' category: #Kernel! +SuspendedProcess class + instanceVariableNames: ''! + +!SuspendedProcess class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +sending: aSymbol to: anObject with: arguments + | message | + message := MessageSend receiver: anObject selector: aSymbol arguments: arguments. + ^self new evaluating: message +! ! + + diff --git a/modules/Kernel/Symbol.Class.st b/modules/Kernel/Symbol.Class.st new file mode 100644 index 00000000..56f36863 --- /dev/null +++ b/modules/Kernel/Symbol.Class.st @@ -0,0 +1,387 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Symbol category: #Kernel! +CharacterArray subclass: #Symbol + instanceVariableNames: '' + classVariableNames: 'SymbolTable' + poolDictionaries: '' + category: 'Kernel'! +!Symbol commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Symbol methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +, aString + ^self asString , aString +! ! + +!Symbol methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aSymbol + aSymbol isSymbol ifFalse: [^self error: 'cannot compare']. + ^self asString <= aSymbol asString +! ! + +!Symbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +arity + | last first | + self isEmpty ifTrue: [^0]. + last := self last. + last isAlphanumeric ifTrue: [^0]. + last = $: ifTrue: [ + first := self first. + ^(first = $_ or: [first isAlphanumeric]) + ifTrue: [self occurrencesOf: $:] + ifFalse: [1]]. + last = $_ ifTrue: [^0]. + ^1 +! ! + +!Symbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asByteArray + | array | + array := ByteArray new: self sizeInBytes. + ^array replaceBytesFrom: 1 to: array size with: self startingAt: 1 +! ! + +!Symbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asString + | string | + string := String new: self size. + ^string replaceFrom: 1 to: self size with: self +! ! + +!Symbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asSymbol + ^self +! ! + +!Symbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asWideString + ^self asString asWideString +! ! + +!Symbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: aCharacter + ^self shouldNotImplement +! ! + +!Symbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: anInteger + ^self characterAtValid: anInteger +! ! + +!Symbol methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicHash + ^self hash +! ! + +!Symbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicSize + ^self _size - 1 +! ! + +!Symbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +capitalized + ^self asString capitalized +! ! + +!Symbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterSize + ^1 +! ! + +!Symbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +codeAt: i + ^self byteAt: i +! ! + +!Symbol methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + ^self +! ! + +!Symbol methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +doubleQuoted + ^self asString doubleQuoted +! ! + +!Symbol methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateFor: anObject + ^anObject perform: self +! ! + +!Symbol methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWith: anObject + ^anObject perform: self +! ! + +!Symbol methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWithArguments: anArray + | n args | + n := anArray size min: self arity + 1. + args := anArray copyFrom: 2 to: n. + ^anArray first perform: self withArguments: args asArray +! ! + +!Symbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +existingSymbol + ^self +! ! + +!Symbol methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +flushCacheFor: species + self errorVMspecific +! ! + +!Symbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + | pseudoindex first second third begin middle end current new | + current := self _basicHash. + current !!= 0 ifTrue: [^current]. + pseudoindex := self basicSize - 1. + pseudoindex < 0 ifTrue: [^0]. + begin := 0. + middle := (pseudoindex bitAnd: 16rFFFF) // 2. + end := middle * 2. + first := (self shortAtOffset: begin) + (256 * (pseudoindex at: 1)). + second := self shortAtOffset: end. + third := self shortAtOffset: middle. + new := first + (second * 4 + third * 4) bitAnd: 16r7FFF. + self _basicHash: new. + ^new +! ! + +!Symbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash16 + | seed hash | + seed := 13131. + hash := self size. + self ASSERT: hash = self size. + 1 to: self size do: [:i | | cp | + cp := self codeAt: i. + hash := hash * seed + cp bitAnd: 16rFFFF]. + ^hash +! ! + +!Symbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashDJB + | hash | + hash := 5381. + 1 + to: self size + do: [:i | hash := ((hash bitShift: 5) bitAnd: 16rFFFF) + hash + (self + codeAt: i) + bitAnd: 16rFFFF]. + ^((hash bitShift: 5) bitAnd: 16rFFFF) + hash + self size +! ! + +!Symbol methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfString: aString from: start to: stop td1: anArray + | m k | + m := aString size. + m = 0 ifTrue: [^0]. + k := start. + [k + m - 1 <= stop] whileTrue: [| i byte delta | + i := 1. + [i <= m and: [(aString at: i) = (self at: k + i - 1)]] + whileTrue: [i := i + 1]. + i > m ifTrue: [^k]. + k + m > stop ifTrue: [^0]. + byte := self byteAt: k + m. + delta := (anArray at: byte + 1) ifNil: [m + 1]. + k := k + delta]. + ^0 +! ! + +!Symbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSymbol + ^true +! ! + +!Symbol methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +keywords + " + #replace:with: keywords + " + self isEmpty ifTrue: [^#()]. + (self noneSatisfy: [:ch | ch isAlphanumeric or: [ch = $_]]) ifTrue: [^{self}]. + self last = $: ifFalse: [^{self}]. + ^Array streamContents: [:stream | | reader | + reader := self asString readStream. + [reader atEnd] whileFalse: [| keyword | + keyword := reader throughAll: ':'. + stream nextPut: keyword]] +! ! + +!Symbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +normalizeToC + " + do nothing + " + +! ! + +!Symbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +nullTerminated + ^self asString nullTerminated +! ! + +!Symbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveReplaceFrom: start to: stop withObject: aCharacter + self checkCharacter: aCharacter. + aCharacter isByteCharacter + ifFalse: [self error: 'Byte symbols cannot hold non-latin1 characters']. + start to: stop do: [:i | self at: i put: aCharacter]. + ^aCharacter +! ! + +!Symbol methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: self asString +! ! + +!Symbol methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceBytesFrom: byteStart to: byteStop with: aVariableByteObject startingAt: byteRepStart + ^self shouldNotImplement +! ! + +!Symbol methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFirst: count with: aCollection + ^self shouldNotImplement +! ! + +!Symbol methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop with: aString startingAt: position + ^self shouldNotImplement +! ! + +!Symbol methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop withObject: aCharacter + ^self shouldNotImplement +! ! + +!Symbol methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +shallowCopy + ^self +! ! + +!Symbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self _size - 1 +! ! + +!Symbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^self size +! ! + +!Symbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +species + ^String +! ! + +!Symbol methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + aStream nextPut: $#. + (self isEmpty or: [| first | + first := self first. + (first isLetter not and: [first ~= $_]) + or: [self anySatisfy: [:char | char isIdentifierCharacter not]]]) + ifTrue: [ + aStream nextPut: $'. + self do: [:char | + aStream nextPut: char. + char = $' ifTrue: [aStream nextPut: $']]. + aStream nextPut: $'] + ifFalse: [aStream nextPutAll: self asString] +! ! + +!Symbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +td1 + " + Sunday Algorithm + ShellDLL current openWebPage: 'http://www.cin.ufpe.br/~paguso/courses/if767/bib/Sunday_1990.pdf' + " + | m td1 | + m := self size. + td1 := Array new: 256. + m to: 1 by: -1 do: [:i | | byte j | + byte := self byteAt: i. + j := byte + 1. + (td1 at: j) isNil ifTrue: [td1 at: j put: m - i + 1]]. + ^td1 +! ! + +!Symbol methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: a value: b + ^(a perform: self) <= (b perform: self) +! ! + +!Symbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +writeStream + ^WriteStringStream on: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Symbol class' category: #Kernel! +Symbol class + instanceVariableNames: 'SymbolTable'! + +!Symbol class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +findInterned: aString + | symbol | + symbol := aString bytes changeClassTo: Symbol. + ^SymbolTable lookup: symbol +! ! + +!Symbol class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromBytes: aByteArray + | n string | + n := aByteArray sizeInBytes. + string := self basicNew: n. + ^string replaceBytesFrom: 1 to: n with: aByteArray startingAt: 1 +! ! + +!Symbol class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeSymbolTable + | policy set | + self == Symbol ifFalse: [^self]. + policy := HashTablePolicy new + storesAssociations: false; + bucketClass: OpenHashTable; + useStringHash. + set := Set new: 5000 using: policy. + SymbolTable := set +! ! + +!Symbol class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +intern: aString + | symbol existing | + aString isWide ifTrue: [^WideSymbol intern: aString]. + symbol := aString bytes changeClassTo: self. + existing := SymbolTable lookup: symbol. + existing == nil ifTrue: [ + existing := symbol. + SymbolTable add: existing]. + ^existing +! ! + +!Symbol class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: ignoreArgument + ^self shouldNotImplement +! ! + +!Symbol class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +startUp + SymbolTable beWeak +! ! + +!Symbol class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +symbolTable + ^SymbolTable +! ! + + diff --git a/modules/Kernel/SymbolicReference.Class.st b/modules/Kernel/SymbolicReference.Class.st new file mode 100644 index 00000000..9dd61746 --- /dev/null +++ b/modules/Kernel/SymbolicReference.Class.st @@ -0,0 +1,186 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #SymbolicReference category: #Kernel! +Object subclass: #SymbolicReference + instanceVariableNames: 'linker token object' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!SymbolicReference commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!SymbolicReference methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aSymbolicReference + aSymbolicReference class == self class ifFalse: [^false]. + ^linker = aSymbolicReference linker and: [token = aSymbolicReference token] +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +asBehavior + ^self asClass instanceBehavior +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +asCharacter + ^(Integer fromString: token) asCharacter +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +asClass + | module | + module := Kernel load: token first. + ^module namespace at: token second +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +asMetaclass + ^self asClass class +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +asMetaclassBehavior + ^self asClass behavior +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +asModule + ^Kernel load: token +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +asSymbol + ^token asSymbol +! ! + +!SymbolicReference methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasBeenLinked + ^object notNil or: [token == #nil] +! ! + +!SymbolicReference methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +link + ^self hasBeenLinked ifTrue: [object] ifFalse: [object := self referredValue]. +! ! + +!SymbolicReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +linker + ^linker +! ! + +!SymbolicReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +linker: aSymbol + linker := aSymbol +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +false + ^false +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +nil + ^nil +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +nilToken + ^HashTable nilToken +! ! + +!SymbolicReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +object + ^object +! ! + +!SymbolicReference methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream + nextPutAll: self type; + nextPutAll: ' ('; + nextPutAll: token printString; + nextPut: $) +! ! + +!SymbolicReference methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +referredValue + ^self perform: linker +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +symbolTable + ^Symbol symbolTable +! ! + +!SymbolicReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +token + ^token +! ! + +!SymbolicReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +token: string + token := string +! ! + +!SymbolicReference methodsFor: 'linking' stamp: 'KenD 28/Jun/2026 13:27:38'! +true + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SymbolicReference class' category: #Kernel! +SymbolicReference class + instanceVariableNames: ''! + +!SymbolicReference class methodsFor: 'knownObjects' stamp: 'KenD 28/Jun/2026 13:27:38'! +forBehavior: aBehavior + | species linker | + species := aBehavior classBinding. + linker := species isMetaclass ifTrue: [#asMetaclassBehavior] ifFalse: [#asBehavior]. + ^(self forClass: species instanceClass) linker: linker +! ! + +!SymbolicReference class methodsFor: 'knownObjects' stamp: 'KenD 28/Jun/2026 13:27:38'! +forClass: aClass + ^self new linker: #asClass; token: {aClass module name. aClass name} +! ! + +!SymbolicReference class methodsFor: 'knownObjects' stamp: 'KenD 28/Jun/2026 13:27:38'! +forMetaclass: aMetaclass + ^(self forClass: aMetaclass instanceClass) linker: #asMetaclass +! ! + +!SymbolicReference class methodsFor: 'knownObjects' stamp: 'KenD 28/Jun/2026 13:27:38'! +forCharacter: aCharacter + ^self new linker: #asCharacter; token: aCharacter codePoint asString +! ! + +!SymbolicReference class methodsFor: 'knownObjects' stamp: 'KenD 28/Jun/2026 13:27:38'! +forModule: aModule + ^self new linker: #asModule; token: aModule name +! ! + +!SymbolicReference class methodsFor: 'knownObjects' stamp: 'KenD 28/Jun/2026 13:27:38'! +forSymbol: aSymbol + ^self new linker: #asSymbol; token: aSymbol +! ! + +!SymbolicReference class methodsFor: 'knownObjects' stamp: 'KenD 28/Jun/2026 13:27:38'! +nilToken + ^self new linker: #nilToken +! ! + +!SymbolicReference class methodsFor: 'knownObjects' stamp: 'KenD 28/Jun/2026 13:27:38'! +symbolTable + ^self new linker: #symbolTable +! ! + +!SymbolicReference class methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +linker: anObject token: anotherObject + ^self new linker: anObject; token: anotherObject +! ! + + diff --git a/modules/Kernel/Time.Class.st b/modules/Kernel/Time.Class.st new file mode 100644 index 00000000..1c6d048e --- /dev/null +++ b/modules/Kernel/Time.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Time category: #Kernel! +Magnitude subclass: #Time + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Time commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Time class' category: #Kernel! +Time class + instanceVariableNames: ''! + +!Time class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +millisecondsToRun: aClosure + | start stop | + start := Kernel host currentMilliseconds. + aClosure value. + stop := Kernel host currentMilliseconds. + ^stop - start +! ! + + diff --git a/modules/Kernel/Timer.Class.st b/modules/Kernel/Timer.Class.st new file mode 100644 index 00000000..73eb820a --- /dev/null +++ b/modules/Kernel/Timer.Class.st @@ -0,0 +1,120 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Timer category: #Kernel! +Object subclass: #Timer + instanceVariableNames: 'milliseconds id count' + classVariableNames: 'Timers' + poolDictionaries: '' + category: 'Kernel'! +!Timer commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Timer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +id + ^id +! ! + +!Timer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +milliseconds + ^milliseconds +! ! + +!Timer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +milliseconds: anInteger + anInteger < 0 ifTrue: [self error: 'negative timer period']. + milliseconds := anInteger asInteger +! ! + +!Timer methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream + nextPutAll: 'Timer '; + print: id; + nextPutAll: ', every '; + print: milliseconds; + nextPutAll: ' ms' +! ! + +!Timer methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! +start + count := 0. + id notNil ifTrue: [(Timers includesKey: id) ifTrue: [^self stop; start]]. + id := self class startTimer: 0 milliseconds: milliseconds for: nil. + self class addTimer: self +! ! + +!Timer methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! +stop + id isNil ifTrue: [^self]. + self class + stopTimer: id for: nil; + removeTimer: self. + id := nil +! ! + +!Timer methodsFor: 'event handlers' stamp: 'KenD 28/Jun/2026 13:27:38'! +tick + count > 2 ifTrue: [^self]. + count := count + 1. + [ + [self triggerEvent: #tick] on: Error do: [:error | + milliseconds < 30000 ifTrue: [self stop]. + error pass]] + ensure: [count := count - 1] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Timer class' category: #Kernel! +Timer class + instanceVariableNames: 'Timers'! + +!Timer class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +addTimer: aTimer + Timers at: aTimer id put: aTimer +! ! + +!Timer class methodsFor: 'events' stamp: 'KenD 28/Jun/2026 13:27:38'! +availableEvents + ^super availableEvents add: #tick; yourself +! ! + +!Timer class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +everySecond + ^self forSeconds: 1 +! ! + +!Timer class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +forSeconds: n + ^self new milliseconds: n * 1000 +! ! + +!Timer class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +milliseconds: n + ^self new milliseconds: n +! ! + +!Timer class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +newId + | next | + next := 1. + [Timers includesKey: next] whileTrue: [next := next + 1]. + ^next +! ! + +!Timer class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeTimer: aTimer + Timers removeKey: aTimer id ifAbsent: nil +! ! + +!Timer class methodsFor: 'events' stamp: 'KenD 28/Jun/2026 13:27:38'! +tick: id + | timer | + timer := Timers at: id ifAbsent: [^nil]. + timer tick +! ! + + diff --git a/modules/Kernel/Timestamp.Class.st b/modules/Kernel/Timestamp.Class.st new file mode 100644 index 00000000..8a749a4e --- /dev/null +++ b/modules/Kernel/Timestamp.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Timestamp category: #Kernel! +Magnitude subclass: #Timestamp + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Timestamp commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Timestamp class' category: #Kernel! +Timestamp class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/True.Class.st b/modules/Kernel/True.Class.st new file mode 100644 index 00000000..6d868dae --- /dev/null +++ b/modules/Kernel/True.Class.st @@ -0,0 +1,121 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #True category: #Kernel! +Boolean subclass: #True + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!True commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +& aBoolean + ^aBoolean +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +| aBoolean + ^self +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +and: aBlock + ^aBlock value +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +and: block1 and: block2 + ^block1 value and: [block2 value] +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +and: block1 and: block2 and: block3 + ^block1 value and: [block2 value] and: [block3 value] +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +and: block1 andNot: block2 + ^block1 value andNot: [block2 value] +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +andNot: aBlock + ^aBlock value not +! ! + +!True methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asParameter + ^1 +! ! + +!True methodsFor: 'flow control' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifFalse: aBlock + ^nil +! ! + +!True methodsFor: 'flow control' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifFalse: aBlock ifTrue: anotherBlock + ^anotherBlock value +! ! + +!True methodsFor: 'flow control' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifTrue: aBlock + ^aBlock value +! ! + +!True methodsFor: 'flow control' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifTrue: aBlock ifFalse: anotherBlock + ^aBlock value +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +not + ^false +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +or: aBlock + ^self +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +or: aBlock or: aBlock2 + ^self +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +orNot: aBlock + ^self +! ! + +!True methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: 'true' +! ! + +!True methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +xor: aBlock + ^aBlock value not +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'True class' category: #Kernel! +True class + instanceVariableNames: ''! + +!True class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +allInstances + ^{true} +! ! + +!True class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBeDeleted + ^false +! ! + + diff --git a/modules/Kernel/UTF16.Class.st b/modules/Kernel/UTF16.Class.st new file mode 100644 index 00000000..7d5d1d6f --- /dev/null +++ b/modules/Kernel/UTF16.Class.st @@ -0,0 +1,165 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #UTF16 category: #Kernel! +Unicode subclass: #UTF16 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!UTF16 commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterIndexesOf: aString from: start to: end + " + UTF16 current characterIndexesOf: '𝑎𝑎𝑎x' from: 3 to: 5 + " + | i e s max n | + aString isWideString ifFalse: [^start thru: end]. + s := i := self characterIndexOf: aString at: start. + n := aString size. + max := end * 2. + e := start * 2. + [i < n and: [e <= max]] whileTrue: [| ch len | + i := i + 1. + ch := aString at: i. + len := self sizeOfCharacter: ch. + e := e + len]. + ^s thru: i - 1 +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterIndexOf: aString at: anInteger + (self isDBS: aString upTo: anInteger - 1) ifTrue: [^anInteger]. + ^super characterIndexOf: aString at: anInteger * 2 +! ! + +!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFrom: aStream + | b1 b2 hi b3 b4 lo | + b1 := aStream nextByte. + b2 := aStream nextByte. + hi := b1 + (b2 bitShift: 8). + b2 < 16rD8 ifTrue: [^hi]. + hi := hi - 16rD800. + hi < 16r400 ifFalse: [^b2 * 256 + b1]. + hi := (hi bitShift: 10) + 16r10000. + b3 := aStream nextByte. + b4 := aStream nextByte. + lo := (b4 bitShift: 8) - 16rDC00 + b3. + ^hi + lo +! ! + +!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aCharacter on: aStream + | code c20 hi lo | + code := aCharacter codePoint. + code < 128 ifTrue: [ + aStream nextPut: code; nextPut: 0. + ^self]. + code < 16rD800 ifTrue: [ + aStream + nextPut: (code bitAnd: 16rFF); + nextPut: (code bitShift: -8). + ^self]. + code < 16rE000 ifTrue: [self error: 'invalid code point']. + code < 16r10000 ifTrue: [ + aStream + nextPut: (code bitAnd: 16rFF); + nextPut: (code bitShift: -8). + ^self]. + code < 16r110000 ifTrue: [ + c20 := code - 16r10000. + hi := (c20 bitShift: -10) + 16rD800. + lo := (c20 bitAnd: 16r3FF) + 16rDC00. + aStream + nextPut: (hi bitAnd: 16rFF); + nextPut: (hi bitShift: -8); + nextPut: (lo bitAnd: 16rFF); + nextPut: (lo bitShift: -8). + ^self]. + self error: 'invalid code point' +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexesOf: aString from: start to: end + | e stretch delta | + e := start - 1 max: end - 1. + (self isDBS: aString upTo: e) ifTrue: [ + delta := end > 0 + ifTrue: [self sizeOfCharacter: (aString at: end)] + ifFalse: [0]. + ^start thru: end - 1 + (delta // 2)]. + stretch := super indexesOf: aString from: start to: end. + ^stretch + 1 // 2 +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDBS: aString + ^self isDBS: aString upTo: aString size +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDBS: aString upTo: anInteger + aString isWide ifFalse: [^true]. + 2 + to: anInteger * 4 + by: 4 + do: [:i | (aString uShortAtOffset: i) = 0 ifFalse: [^false]]. + ^true +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +lengthOf: aString + ^(self encode: aString) size // 2 +! ! + +!UTF16 methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +minBytesPerChar + ^2 +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +parameterFrom: aString + | strm | + strm := (ByteArray new: aString size + 1 * 2) writeStream. + aString isCharacter + ifTrue: [self encode: aString on: strm] + ifFalse: [aString do: [:char | self encode: char on: strm]]. + strm nextPut: 0; nextPut: 0. + ^strm contents +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytesOf: aString + aString isWideString ifFalse: [^aString size + 1 * 2]. + ^super sizeInBytesOf: aString +! ! + +!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeOfCharacter: aCharacter + ^aCharacter codePoint < 16r10000 ifTrue: [2] ifFalse: [4] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'UTF16 class' category: #Kernel! +UTF16 class + instanceVariableNames: ''! + +!UTF16 class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFromAddress: externalAddress length: anInteger + | stream | + stream := externalAddress readStream readLimit: anInteger * 2. + ^self current decodeStringFrom: stream length: anInteger +! ! + +!UTF16 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prefix + ^#[16rFE 16rFF] +! ! + + diff --git a/modules/Kernel/UTF32.Class.st b/modules/Kernel/UTF32.Class.st new file mode 100644 index 00000000..b8b115c0 --- /dev/null +++ b/modules/Kernel/UTF32.Class.st @@ -0,0 +1,36 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #UTF32 category: #Kernel! +Unicode subclass: #UTF32 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!UTF32 commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!UTF32 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decode: aByteArray + ^WideString newFrom: aByteArray +! ! + +!UTF32 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aCharacter on: aStream + aStream nextULongPut: aCharacter codePoint +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'UTF32 class' category: #Kernel! +UTF32 class + instanceVariableNames: ''! + +!UTF32 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prefix + ^#[16rFE 16rFF 0 0] +! ! + + diff --git a/modules/Kernel/UTF8.Class.st b/modules/Kernel/UTF8.Class.st new file mode 100644 index 00000000..1a640a1e --- /dev/null +++ b/modules/Kernel/UTF8.Class.st @@ -0,0 +1,224 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #UTF8 category: #Kernel! +Unicode subclass: #UTF8 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!UTF8 commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!UTF8 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +accepts: aByteArray + | stream | + stream := aByteArray readStream. + [stream atEnd] whileFalse: [| s | + s := self sizeOfEncoding: stream next. + s = 0 ifTrue: [^false]. + s - 1 timesRepeat: [ + stream atEnd ifTrue: [^false]. + (stream next bitAnd: 0xC0) = 0x80 ifFalse: [^false]]]. + ^true +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decode: aByteArray + aByteArray isExternalMemory + ifTrue: [^self class decodeMemory: aByteArray length: aByteArray length]. + 1 + to: aByteArray size + do: [:i | (aByteArray at: i) asInteger > 127 + ifTrue: [^super decode: aByteArray]]. + ^aByteArray asString +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFrom: aStream + | b1 flags count bytes b2 b3 b4 | + b1 := aStream nextByte. + b1 < 128 ifTrue: [^b1]. + flags := b1 bitAnd: 16rF8. + count := self trailing: flags. + count isNil ifTrue: [^b1]. + bytes := aStream peek: count. + bytes size < count ifTrue: [^b1]. + 1 + to: count + do: [:i | ((bytes byteAt: i) bitAnd: 16rC0) = 16r80 ifFalse: [^b1]]. + aStream skip: count. + count = 1 ifTrue: [ + b2 := bytes byteAt: 1. + b1 := b1 bitAnd: 16r1F. + ^(b1 bitShift: 6) + (b2 bitAnd: 16r3F)]. + count = 2 ifTrue: [ + b2 := (bytes byteAt: 1) bitAnd: 16r3F. + b3 := (bytes byteAt: 2) bitAnd: 16r3F. + b1 := b1 bitAnd: 16rF. + ^(b1 bitShift: 12) + (b2 bitShift: 6) + b3]. + b2 := (bytes byteAt: 1) bitAnd: 16r3F. + b3 := (bytes byteAt: 2) bitAnd: 16r3F. + b4 := (bytes byteAt: 3) bitAnd: 16r3F. + b1 := b1 bitAnd: 7. + ^(b1 bitShift: 18) + (b2 bitShift: 12) + (b3 bitShift: 6) + b4 +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aString + aString class = String ifTrue: [ + 1 + to: aString size + do: [:i | (aString codeAt: i) < 128 ifFalse: [^super encode: aString]]. + ^aString asByteArray]. + ^super encode: aString +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aCharacter on: aStream + | code b1 b2 b3 b4 | + code := aCharacter codePoint. + code < 128 ifTrue: [ + aStream nextBytePut: code. + ^self]. + code < 16r800 ifTrue: [ + b1 := code bitShift: -6. + b1 := b1 bitOr: 16rC0. + b2 := code bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + aStream nextBytePut: b1; nextBytePut: b2. + ^self]. + code < 16r10000 ifTrue: [ + b1 := code bitShift: -12. + b1 := b1 bitOr: 16rE0. + b2 := code bitShift: -6. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + aStream + nextBytePut: b1; + nextBytePut: b2; + nextBytePut: b3. + ^self]. + b1 := code bitShift: -18. + b1 := b1 bitOr: 16rF0. + b2 := code bitShift: -12. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitShift: -6. + b3 := b3 bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + b4 := code bitAnd: 16r3F. + b4 := b4 bitOr: 16r80. + aStream + nextBytePut: b1; + nextBytePut: b2; + nextBytePut: b3; + nextBytePut: b4 +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encodeCharacter: aCharacter + | code b1 b2 b3 b4 | + code := aCharacter codePoint. + code < 128 ifTrue: [^ByteArray with: code]. + code < 16r800 ifTrue: [ + b1 := code bitShift: -6. + b1 := b1 bitOr: 16rC0. + b2 := code bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + ^ByteArray with: b1 with: b2]. + code < 16r10000 ifTrue: [ + b1 := code bitShift: -12. + b1 := b1 bitOr: 16rE0. + b2 := code bitShift: -6. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + ^ByteArray with: b1 with: b2 with: b3]. + b1 := code bitShift: -18. + b1 := b1 bitOr: 16rF0. + b2 := code bitShift: -12. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitShift: -6. + b3 := b3 bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + b4 := code bitAnd: 16r3F. + b4 := b4 bitOr: 16r80. + ^ByteArray with: b1 with: b2 with: b3 with: b4 +! ! + +!UTF8 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +parameterFrom: aString + | strm | + strm := (ByteArray new: aString size + 1) writeStream. + aString isCharacter + ifTrue: [self encode: aString on: strm] + ifFalse: [aString do: [:char | self encode: char on: strm]]. + strm nextPut: 0. + ^strm contents +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeOfCharacter: aCharacter + | code | + code := aCharacter codePoint. + code < 128 ifTrue: [^1]. + code < 16r800 ifTrue: [^2]. + code < 16r10000 ifTrue: [^3]. + ^4 +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeOfEncoding: code + code < 0x80 ifTrue: [^1]. + code < 0xC0 ifTrue: [^0]. + code < 0xE0 ifTrue: [^2]. + code < 0xF0 ifTrue: [^3]. + code < 0xF8 ifTrue: [^4]. + ^0 +! ! + +!UTF8 methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +trailing: byte + (byte bitAnd: 2r11100000) = 2r11000000 ifTrue: [^1]. + (byte bitAnd: 2r11110000) = 2r11100000 ifTrue: [^2]. + (byte bitAnd: 2r11111000) = 2r11110000 ifTrue: [^3]. + ^nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'UTF8 class' category: #Kernel! +UTF8 class + instanceVariableNames: ''! + +!UTF8 class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +accepts: aByteArray + ^self current accepts: aByteArray +! ! + +!UTF8 class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeMemory: anExternalMemory length: anInteger + ^Smalltalk os utf8ToWide: anExternalMemory length: anInteger +! ! + +!UTF8 class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +encodeMemory: anExternalMemory length: anInteger + " + UTF8 encodeMemory: '→' externalCopy length: 2 + " + Smalltalk os wideToUtf8: anExternalMemory length: anInteger +! ! + +!UTF8 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prefix + ^#[16rEF 16rBB 16rBF] +! ! + + diff --git a/modules/Kernel/UndefinedObject.Class.st b/modules/Kernel/UndefinedObject.Class.st new file mode 100644 index 00000000..17cb3340 --- /dev/null +++ b/modules/Kernel/UndefinedObject.Class.st @@ -0,0 +1,131 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #UndefinedObject category: #Kernel! +Object subclass: #UndefinedObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!UndefinedObject commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!UndefinedObject methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asParameter + ^0 +! ! + +!UndefinedObject methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBePrintedAsLiteral + ^true +! ! + +!UndefinedObject methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + ^self +! ! + +!UndefinedObject methodsFor: 'ffi support' stamp: 'KenD 28/Jun/2026 13:27:38'! +externalCopy + ^nil +! ! + +!UndefinedObject methodsFor: 'ffi support' stamp: 'KenD 28/Jun/2026 13:27:38'! +free + " + do nothing + " + +! ! + +!UndefinedObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifNil: aBlock + ^aBlock value +! ! + +!UndefinedObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifNil: aBlock ifNotNil: anotherBlock + ^aBlock value +! ! + +!UndefinedObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifNotNil: aBlock + ^self +! ! + +!UndefinedObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +ifNotNil: aBlock ifNil: nilBlock + ^nilBlock argumentCount = 1 + ifTrue: [nilBlock value: self] + ifFalse: [nilBlock value] +! ! + +!UndefinedObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmptyOrNil + ^true +! ! + +!UndefinedObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isFixedObject + ^true +! ! + +!UndefinedObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isNil + ^true +! ! + +!UndefinedObject methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +notNil + ^false +! ! + +!UndefinedObject methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: 'nil' +! ! + +!UndefinedObject methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +shallowCopy + ^self +! ! + +!UndefinedObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^0 +! ! + +!UndefinedObject methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storeOn: aStream + self printOn: aStream +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'UndefinedObject class' category: #Kernel! +UndefinedObject class + instanceVariableNames: ''! + +!UndefinedObject class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +allInstances + ^Array new: 1 +! ! + +!UndefinedObject class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canBeDeleted + ^false +! ! + +!UndefinedObject class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self shouldNotImplement +! ! + +!UndefinedObject class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self shouldNotImplement +! ! + + diff --git a/modules/Kernel/Unicode.Class.st b/modules/Kernel/Unicode.Class.st new file mode 100644 index 00000000..f0eb062a --- /dev/null +++ b/modules/Kernel/Unicode.Class.st @@ -0,0 +1,193 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Unicode category: #Kernel! +Object subclass: #Unicode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Unicode commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterIndexOf: aString at: anInteger + | index s | + index := 0. + s := 0. + [s < anInteger] whileTrue: [| ch len | + index := index + 1. + ch := aString at: index. + len := self sizeOfCharacter: ch. + s := s + len]. + ^index +! ! + +!Unicode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +compareStringiW: aString1 with: aString2 + ^UTF16 current compareStringiW: aString1 with: aString2 +! ! + +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decode: aByteArray + ^self decodeStringFrom: aByteArray readStream +! ! + +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFrom: aStream + self subclassResponsibility +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeStringFrom: aStream + ^self + decodeStringFrom: aStream + length: aStream size // self minBytesPerChar +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeStringFrom: aStream length: anInteger + | string | + string := String new: anInteger. + ^self decodeStringFrom: aStream on: string +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeStringFrom: aStream on: buffer + | bytes code string index n | + bytes := true. + index := 0. + code := nil. + string := buffer. + n := string size. + [aStream atEnd or: [code = 0] or: [index >= n]] whileFalse: [ + code := self decodeFrom: aStream. + (bytes andNot: [Ansi isAnsi: code]) ifTrue: [ + bytes := false. + string := string asWideString]. + code = 0 ifFalse: [ + index := index + 1. + string at: index putCode: code]]. + ^index < string size ifTrue: [string copyTo: index] ifFalse: [string] +! ! + +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aString + ^ByteArray + streamContents: [:strm | aString do: [:ch | self encode: ch on: strm]] +! ! + +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aCharacter on: aStream + self subclassResponsibility +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +externalCopyOf: aString + | bytes | + aString isNil ifTrue: [^nil]. + bytes := self parameterFrom: aString. + ^bytes externalCopy +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexesOf: aString from: start to: end + " + UTF16 current indexesOf: (WideString with: $𝑎 with: $_ with: $𝑎 with: $→) from: 2 to: 3 + " + | s e | + s := 1. + 1 to: start - 1 do: [:i | | ch len | + ch := aString at: i. + len := self sizeOfCharacter: ch. + s := s + len]. + e := s - 1. + start to: end do: [:i | | ch len | + ch := aString at: i. + len := self sizeOfCharacter: ch. + e := e + len]. + ^s thru: e +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isString: s1 greaterThan: s2 + ^(self compareStringiW: s1 with: s2) > 0 +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isString: s1 greaterThanOrEqualTo: s2 + ^(self compareStringiW: s1 with: s2) >= 0 +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isString: s1 lessThan: s2 + ^(self compareStringiW: s1 with: s2) < 0 +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isString: s1 lessThanOrEqualTo: s2 + ^(self compareStringiW: s1 with: s2) <= 0 +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +lowercaseOf: aString + ^UTF16 current lowercaseOf: aString +! ! + +!Unicode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +minBytesPerChar + ^1 +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytesOf: aString + | size | + size := self sizeOfCharacter: Character null. + 1 to: aString size do: [:i | | ch s | + ch := aString at: i. + s := self sizeOfCharacter: ch. + size := size + s]. + ^size +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +uppercaseOf: aString + ^UTF16 current uppercaseOf: aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Unicode class' category: #Kernel! +Unicode class + instanceVariableNames: ''! + +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decode: aByteArray + ^self current decode: aByteArray +! ! + +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeBytes: aByteArray + | decoder stream | + stream := aByteArray readStream. + decoder := self decoderFor: stream. + ^decoder decode: stream upToEnd +! ! + +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFromAddress: externalAddress length: anInteger + ^self current + decodeStringFrom: externalAddress readStream + length: anInteger +! ! + +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decoderFor: aStream + (aStream peekForAll: UTF32 prefix) ifTrue: [^UTF32]. + (aStream peekForAll: UTF16 prefix) ifTrue: [^UTF16]. + ^UTF8 +! ! + + diff --git a/modules/Kernel/VM/Closure.Extension.st b/modules/Kernel/VM/Closure.Extension.st new file mode 100644 index 00000000..d21c6e7c --- /dev/null +++ b/modules/Kernel/VM/Closure.Extension.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!Closure methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +asCallback + +! ! + +!Closure methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +value + +! ! + +!Closure methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateAtomically + +! ! + +!Closure methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: arg1 + +! ! + +!Closure methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: arg1 value: arg2 + +! ! + +!Closure methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +value: arg1 value: arg2 value: arg3 + +! ! + +!Closure methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWith: arg1 + +! ! + +!Closure methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +evaluateWith: arg1 with: arg2 + +! ! + +!Closure methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +argumentCount + +! ! + + diff --git a/modules/Kernel/VM/CompiledMethod.Extension.st b/modules/Kernel/VM/CompiledMethod.Extension.st new file mode 100644 index 00000000..6a89d467 --- /dev/null +++ b/modules/Kernel/VM/CompiledMethod.Extension.st @@ -0,0 +1,14 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!CompiledMethod methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +flushFromCaches + +! ! + +!CompiledMethod methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +prepareForExecution + +! ! + + diff --git a/modules/Kernel/VM/Float.Extension.st b/modules/Kernel/VM/Float.Extension.st new file mode 100644 index 00000000..e831bd36 --- /dev/null +++ b/modules/Kernel/VM/Float.Extension.st @@ -0,0 +1,129 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aNumber + + ^aNumber isFloat + ifTrue: [self errorOn: #'-'] + ifFalse: [self - aNumber asFloat] +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +* aNumber + + ^aNumber isFloat + ifTrue: [self errorOn: #'*'] + ifFalse: [self * aNumber asFloat] + +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +/ aNumber + + ^aNumber isFloat + ifTrue: [self errorOn: #'/'] + ifFalse: [self / aNumber asFloat] +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aNumber + + ^aNumber isFloat + ifTrue: [ self errorOn: #'+'] + ifFalse: [aNumber addTo: self] +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +< aNumber + + ^aNumber isFloat + ifTrue: [self errorOn: #'<'] + ifFalse: [self < aNumber asFloat] +! ! + +!Float methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aNumber + | nan status | + + ^aNumber isFloat + ifTrue: [ + status := Float status. + nan := self isNaN. + (nan and: [aNumber isNaN]) ifTrue: [^true]. + (nan or: [aNumber isNaN]) ifTrue: [^false]. + self errorOn: #'=' status: status] + ifFalse: [aNumber isNumber + ifTrue: [self = aNumber asFloat] + ifFalse: [false]] +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + + ^self primitiveFailed +! ! + +!Float methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: index + + ^self primitiveFailed +! ! + +!Float methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +errorOn: aSymbol + ^self errorOn: aSymbol status: Float status +! ! + +!Float methodsFor: 'random' stamp: 'KenD 28/Jun/2026 13:27:38'! +fractionPart + + self errorOn: #fractionPart +! ! + +!Float methodsFor: 'random' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeWith: bytes + self replaceBytesFrom: 1 to: 8 with: bytes startingAt: 1 +! ! + +!Float methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +significand + + ^self errorOn: #significand +! ! + +!Float methodsFor: 'functions' stamp: 'KenD 28/Jun/2026 13:27:38'! +sqrt + + ^self errorOn: #sqrt status: status +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +timesTwoPower: anInteger + + ^self errorOn: #timesTwoPower status: 0 +! ! + +!Float methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +truncated + + ^self errorOn: #truncated status: 0 +! ! + +!Float class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromInteger: anInteger + +! ! + +!Float class methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + +! ! + +!Float class methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +status + " Returns the processor's float status register of the last primitive operation " + +! ! + + diff --git a/modules/Kernel/VM/HashTable.Extension.st b/modules/Kernel/VM/HashTable.Extension.st new file mode 100644 index 00000000..76c13276 --- /dev/null +++ b/modules/Kernel/VM/HashTable.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!HashTable class methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primeFor: anInteger + +! ! + + diff --git a/modules/Kernel/VM/Namespace.Extension.st b/modules/Kernel/VM/Namespace.Extension.st new file mode 100644 index 00000000..01abd629 --- /dev/null +++ b/modules/Kernel/VM/Namespace.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!Namespace class methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + +! ! + + diff --git a/modules/Kernel/VM/ProcessStack.Extension.st b/modules/Kernel/VM/ProcessStack.Extension.st new file mode 100644 index 00000000..ae1be248 --- /dev/null +++ b/modules/Kernel/VM/ProcessStack.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!ProcessStack class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aProcess + ^ProcessVMStack new process: aProcess +! ! + + diff --git a/modules/Kernel/VM/ProtoObject.Extension.st b/modules/Kernel/VM/ProtoObject.Extension.st new file mode 100644 index 00000000..45f8ecce --- /dev/null +++ b/modules/Kernel/VM/ProtoObject.Extension.st @@ -0,0 +1,76 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_beSpecial + + self primitiveFailed. + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_hash + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isBytes + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_pointersSize + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_size + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +behavior + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +behavior: aBehavior + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +class + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +== anObject + +! ! + +!ProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +perform: aSymbol withArguments: anArray + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveSize + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveAt: index + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveAt: anInteger put: anObject + +! ! + +!ProtoObject methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicHash + +! ! + + diff --git a/modules/Kernel/VM/SmallInteger.Extension.st b/modules/Kernel/VM/SmallInteger.Extension.st new file mode 100644 index 00000000..e5b97159 --- /dev/null +++ b/modules/Kernel/VM/SmallInteger.Extension.st @@ -0,0 +1,104 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +- aNumber + + aNumber _isSmallInteger ifTrue: [^self asLargeInteger - aNumber]. + ^(aNumber - self) negated +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!!= aNumber + + ^aNumber !!= self +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +* aNumber + + aNumber _isSmallInteger ifTrue: [^self asLargeInteger * aNumber]. + ^aNumber * self +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +// aNumber + +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +\\ aNumber + +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ aNumber + + aNumber _isSmallInteger ifTrue: [^self asLargeInteger + aNumber]. + ^aNumber + self +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! += aNumber + + ^aNumber = self +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +> aNumber + + ^aNumber < self +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +>= aNumber + + ^aNumber <= self +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitAnd: anInteger + | sum | + + anInteger isInteger ifFalse: [^anInteger bitAnd: self]. + (self < 0 and: [anInteger < 0]) ifTrue: [^anInteger bitAnd: self]. + sum := 0. + WordSize to: 1 by: -1 do: [:i | | ai si | + ai := anInteger at: i. + si := self at: i. + sum := (sum bitShift: 8) + (si bitAnd: ai)]. + ^sum +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitOr: anInteger + + ^anInteger bitOr: self +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitXor: anInteger + + ^anInteger bitXor: self +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +bitShift: anInteger + + anInteger = 0 ifTrue: [^self]. + ^anInteger > 0 + ifTrue: [self bitShiftLeft: anInteger] + ifFalse: [self bitShiftRight: 0 - anInteger] +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +highBit + +! ! + +!SmallInteger methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + +! ! + + diff --git a/modules/Kernel/VM/Species.Extension.st b/modules/Kernel/VM/Species.Extension.st new file mode 100644 index 00000000..ba40036d --- /dev/null +++ b/modules/Kernel/VM/Species.Extension.st @@ -0,0 +1,29 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!Species methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew + +! ! + +!Species methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew: anInteger + +! ! + +!Species methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + +! ! + +!Species methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + +! ! + +!Species methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNewBytes: anInteger + +! ! + + diff --git a/modules/Kernel/VM/String.Extension.st b/modules/Kernel/VM/String.Extension.st new file mode 100644 index 00000000..0f4bca0d --- /dev/null +++ b/modules/Kernel/VM/String.Extension.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!String methodsFor: '*Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: end with: collection startingAt: index + + collection hasBytes + ifTrue: [self + replaceBytesFrom: start + to: end + with: collection + startingAt: index] + ifFalse: [super + replaceFrom: start + to: end + with: collection + startingAt: index] +! ! + + diff --git a/modules/Kernel/VM/Symbol.Extension.st b/modules/Kernel/VM/Symbol.Extension.st new file mode 100644 index 00000000..aa0cb1da --- /dev/null +++ b/modules/Kernel/VM/Symbol.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! + + +!Symbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +flushCacheFor: species + +! ! + + diff --git a/modules/Kernel/Warning.Class.st b/modules/Kernel/Warning.Class.st new file mode 100644 index 00000000..58bce5bb --- /dev/null +++ b/modules/Kernel/Warning.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #Warning category: #Kernel! +Notification subclass: #Warning + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Warning commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Warning methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultAction + Kernel host logWarning: self description, String cr +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Warning class' category: #Kernel! +Warning class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/WeakArray.Class.st b/modules/Kernel/WeakArray.Class.st new file mode 100644 index 00000000..83a4f0f9 --- /dev/null +++ b/modules/Kernel/WeakArray.Class.st @@ -0,0 +1,29 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #WeakArray category: #Kernel! +Array subclass: #WeakArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!WeakArray commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WeakArray class' category: #Kernel! +WeakArray class + instanceVariableNames: ''! + +!WeakArray class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + | array | + array := super new: anInteger. + array beWeak. + ^array +! ! + + diff --git a/modules/Kernel/WeakIdentityDictionary.Class.st b/modules/Kernel/WeakIdentityDictionary.Class.st new file mode 100644 index 00000000..fbe7f3e4 --- /dev/null +++ b/modules/Kernel/WeakIdentityDictionary.Class.st @@ -0,0 +1,86 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #WeakIdentityDictionary category: #Kernel! +Dictionary subclass: #WeakIdentityDictionary + instanceVariableNames: 'critical' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!WeakIdentityDictionary commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!WeakIdentityDictionary methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anAssociation + self ASSERT: anAssociation class == Ephemeron. + ^self critical: [super add: anAssociation] +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationClass + ^Ephemeron new registry: self +! ! + +!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationsDo: aBlock + self critical: [ + super associationsDo: [:ephemeron | | hold | + hold := ephemeron key. + hold notNil ifTrue: [aBlock value: ephemeron]]] +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +critical: aBlock + | save | + save := critical. + critical := true. + ^[aBlock value] ensure: [critical := save] +! ! + +!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + self associationsDo: [:assoc | aBlock evaluateWith: assoc value] +! ! + +!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +ephemeronsDo: aBlock + self associationsDo: aBlock +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +equates: element with: ephemeron + ^element == ephemeron key +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashFor: element + ^element basicHash +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyCollector + ^IdentitySet new: self size +! ! + +!WeakIdentityDictionary methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +onTable: aHashTable + critical := false. + super onTable: aHashTable +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +rescue: anEphemeron + critical + ifTrue: [anEphemeron activate] + ifFalse: [self removeKey: anEphemeron key ifAbsent: nil] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WeakIdentityDictionary class' category: #Kernel! +WeakIdentityDictionary class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/WeakIdentitySet.Class.st b/modules/Kernel/WeakIdentitySet.Class.st new file mode 100644 index 00000000..812cc8fd --- /dev/null +++ b/modules/Kernel/WeakIdentitySet.Class.st @@ -0,0 +1,88 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #WeakIdentitySet category: #Kernel! +IdentitySet subclass: #WeakIdentitySet + instanceVariableNames: 'finalizer' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!WeakIdentitySet commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!WeakIdentitySet methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: element + | ephemeron | + element == nil ifTrue: [^element]. + [ + ephemeron := Ephemeron new registry: self. + ephemeron key: element value: nil. + (table atKey: element put: ephemeron) == nil ifTrue: [self incrementTally]] evaluateAtomically. + ^element +! ! + +!WeakIdentitySet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAdd: element + element isNil ifTrue: [^self]. + tally := tally + 1. + self ASSERT: element class == Ephemeron. + table basicAtKey: element key put: element. + ^element +! ! + +!WeakIdentitySet methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + [super do: [:e | aBlock value: e key]] evaluateAtomically +! ! + +!WeakIdentitySet methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +ephemeronsDo: aBlock + super do: [:e | aBlock value: e] +! ! + +!WeakIdentitySet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +equates: key with: element + ^key == element key +! ! + +!WeakIdentitySet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +finalizer: evaluableAction + finalizer := evaluableAction +! ! + +!WeakIdentitySet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashFor: object + ^object basicHash +! ! + +!WeakIdentitySet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyFor: anObject + ^anObject key +! ! + +!WeakIdentitySet methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:38'! +remove: anObject ifAbsent: aBlock + ^[super remove: anObject ifAbsent: aBlock] evaluateAtomically +! ! + +!WeakIdentitySet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +rescue: anEphemeron + self remove: anEphemeron key ifAbsent: nil. + finalizer isNil ifTrue: [^self]. + finalizer evaluateWith: anEphemeron key +! ! + +!WeakIdentitySet methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +storesAssociations + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WeakIdentitySet class' category: #Kernel! +WeakIdentitySet class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/WideString.Class.st b/modules/Kernel/WideString.Class.st new file mode 100644 index 00000000..a2a9b654 --- /dev/null +++ b/modules/Kernel/WideString.Class.st @@ -0,0 +1,506 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #WideString category: #Kernel! +String subclass: #WideString + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!WideString commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!WideString methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +, aString + | n string | + aString isString ifFalse: [^super , aString]. + n := self size. + string := WideString new: n + aString size. + ^string + replaceBytesFrom: 1 to: self sizeInBytes with: self startingAt: 1; + replaceFrom: n + 1 to: string size with: aString startingAt: 1 +! ! + +!WideString methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aString + ^UTF16 current isString: self lessThanOrEqualTo: aString +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asByteCharacters + | n result | + n := self size. + result := String new: n. + 1 to: n do: [:i | | code char | + code := self codeAt: i. + char := code < 256 ifTrue: [code] ifFalse: [$? asInteger]. + result byteAt: i put: char]. + ^result +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asLowercase + ^UTF16 current lowercaseOf: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asSymbol + ^WideSymbol intern: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asUppercase + ^UTF16 current uppercaseOf: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asWideString + ^self +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + | cp | + cp := self checkIndex: index; codeAt: index. + ^Character value: cp +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: aCharacter + self + checkCharacter: aCharacter; + at: anInteger putCode: aCharacter codePoint. + ^aCharacter +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index putCode: codePoint + ^self + checkIndex: index; + uLongAtOffset: index - 1 * 4 put: codePoint +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: index + | cp | + cp := self codeAt: index. + ^Character value: cp +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: anInteger put: aCharacter + self at: anInteger putCode: aCharacter codePoint. + ^aCharacter +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: index putCode: codePoint + ^self uLongAtOffset: index - 1 * 4 put: codePoint +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger + ^self basicByteAt: anInteger +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger put: anObject + ^self basicByteAt: anInteger put: anObject +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicSize + ^self _size +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: anInteger + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger <= self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^self _byteAt: anInteger +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: position put: asciiValue + position _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= position and: [position <= self _size]) + ifFalse: [^self outOfBoundsIndex: position]. + (0 <= asciiValue and: [asciiValue < 256]) + ifFalse: [^self error: 'invalid character']. + ^self _byteAt: position put: asciiValue +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterSize + ^4 +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +checkByteIndex: index + index isInteger ifFalse: [self error: 'strings are indexed by integers']. + (index between: 1 and: self sizeInBytes) + ifFalse: [self + error: 'index: ' , index printString , ' is outside of string bounds'] +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +codeAt: index + ^self uLongAtOffset: index - 1 * 4 +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +composeCharacters + ^UTF16 current compose: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decomposeCharacters + ^UTF16 current decompose: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +existingSymbol + ^WideSymbol findInterned: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +foldDigits + ^UTF16 current foldDigitsOf: self +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromCodePoints: aCollection + 1 to: aCollection size do: [:i | | ci | + ci := aCollection at: i. + self at: i putCode: ci] +! ! + +!WideString methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + | hash | + hash := self size. + 0 + to: self sizeInBytes - 4 + by: 4 + do: [:i | hash := (hash hashMultiply: 16r19660D) + bitXor: (self uLongAtOffset: i)]. + ^hash +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexAt: anInteger + ^anInteger +! ! + +!WideString methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfString: aString from: start to: stop td1: anArray + | m k | + m := aString size. + m = 0 ifTrue: [^0]. + k := start. + [k + m - 1 <= stop] whileTrue: [| i code delta | + i := 1. + [i <= m and: [(aString at: i) = (self at: k + i - 1)]] + whileTrue: [i := i + 1]. + i > m ifTrue: [^k]. + k + m > stop ifTrue: [^0]. + code := self codeAt: k + m. + delta := anArray at: code + 1 ifAbsent: nil. + delta isNil ifTrue: [delta := m + 1]. + k := k + delta]. + ^0 +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isByteCompliant + 1 to: self size do: [:i | | char | + char := self at: i. + char isByteCharacter ifFalse: [^false]]. + ^true +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCNormal + ^UTF16 current isCNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDNormal + ^UTF16 current isDNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isKCNormal + ^UTF16 current isKCNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isKDNormal + ^UTF16 current isKDNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWide + ^true +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWideString + ^true +! ! + +!WideString methodsFor: 'inquires' stamp: 'KenD 28/Jun/2026 13:27:38'! +length + ^UTF16 current lengthOf: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +normalizeToC + ^UTF16 current normalizeToC: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +normalizeToD + ^(UTF16 current normalizeToD: self) reduced +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +normalizeToKC + ^UTF16 current normalizeToKC: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +normalizeToKD + ^UTF16 current normalizeToKD: self +! ! + +!WideString methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printChunkOn: aStream from: anInteger + ^self printUTF8ChunkOn: aStream from: anInteger +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +reduced + ^self isByteCompliant ifTrue: [self asByteCharacters] ifFalse: [self] +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replace: anInteger with: aString + 1 to: anInteger do: [:i | | char | + char := aString at: i. + self at: i put: char] +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFirst: anInteger with: aString + 1 to: anInteger do: [:i | | char | + char := aString at: i. + self at: i put: char] +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop with: aString startingAt: position + | string | + string := self replacementFrom: aString. + super + replaceFrom: start - 1 * 4 + 1 + to: stop * 4 + with: string + startingAt: position - 1 * 4 + 1 +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop withObject: aCharacter + self checkIndex: start; checkIndex: stop. + start to: stop do: [:i | self at: i put: aCharacter] +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replacementFrom: aString + | n wide | + aString class == self class ifTrue: [^aString]. + aString isExternalMemory ifTrue: [^WideString fromMemory: aString]. + n := aString size. + wide := WideString new: n. + 1 to: n do: [:i | | ch | + ch := aString atValid: i. + wide atValid: i put: ch]. + ^wide +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self basicSize // 4 +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^self basicSize +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +td1 + | m td1 | + m := self size. + td1 := Dictionary new: m. + m to: 1 by: -1 do: [:i | | code | + code := self codeAt: i. + td1 at: code + 1 ifAbsentPut: [m - i + 1]]. + ^td1 +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveULongAtOffset: offset +put: anInteger + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 3 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uLongAtValidOffset: offset put: anInteger +! ! + +!WideString methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLongAtValidOffset: offset put: anInteger + anInteger size > 4 ifTrue: [self error: 'does not fit in 32 bits']. + self _uLongAtOffset: offset put: anInteger. + ^anInteger +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +unaccented + ^self normalizeToD reject: [:ch | ch isNonSpacingMark] +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf8Bytes + ^UTF8 current encode: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WideString class' category: #Kernel! +WideString class + instanceVariableNames: ''! + +!WideString class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew: anInteger + ^self primitiveNewBytes: anInteger +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromBytes: aByteArray + ^UTF16 current + decodeStringFrom: aByteArray readStream + on: (self new: aByteArray size) +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromCodePoints: aCollection + | string | + string := self new: aCollection size. + ^string fromCodePoints: aCollection +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromExternalUTF16: anExternalMemory + ^UTF16 current decodeStringFrom: anExternalMemory readStream +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromExternalUTF16: anExternalMemory length: anInteger + | stream | + stream := anExternalMemory readStream. + stream readLimit: anInteger. + ^UTF16 current decodeStringFrom: stream +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromExternalUTF8: anExternalMemory + ^UTF8 current decodeStringFrom: anExternalMemory readStream +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromMemory: anExternalMemory + | s i | + s := self new: 1. + i := 1. + [ + s replaceBytesFrom: 1 to: 2 with: anExternalMemory startingAt: i. + (s codeAt: 1) = 0] + whileFalse: [i := i + 2]. + ^self fromMemory: anExternalMemory length: i - 1 // 2 +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromMemory: anExternalMemory length: anInteger + | bytes | + bytes := anExternalMemory readStream readLimit: anInteger * 2. + ^UTF16 current decodeStringFrom: bytes on: (self new: anInteger) +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromMultiByte: aByteArray codePage: anInteger + " + WideString fromMultiByte: #[16rFA] codePage: 1251 + " + | bytes string | + bytes := aByteArray externalCopy. + string := self + fromMultiByteAddress: bytes + codePage: anInteger + size: aByteArray sizeInBytes. + bytes free. + ^string +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString + aString class == String ifTrue: [^aString asWideString]. + aString class == self ifTrue: [^aString]. + ^self fromUTF8: aString asString utf8 +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromUTF8: aByteArray + ^UTF8 current + decodeStringFrom: aByteArray readStream + on: (self new: aByteArray size) +! ! + +!WideString class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self basicNew: anInteger * 4 +! ! + +!WideString class methodsFor: 'gs' stamp: 'KenD 28/Jun/2026 13:27:38'! +newFrom: aByteArray + ^aByteArray copy changeClassTo: self +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +stringFromMemory: anExternalMemory + | s i | + s := self new: 1. + i := 1. + [ + s replaceBytesFrom: 1 to: 2 with: anExternalMemory startingAt: i. + (s codeAt: 1) = 0] + whileFalse: [i := i + 2]. + ^UTF16 decodeFromAddress: anExternalMemory length: i - 1 // 2 +! ! + +!WideString class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +stringsFromAddress: anExternalMemory + | strings memory | + strings := OrderedCollection new. + memory := anExternalMemory. + [(memory at: 1) = 0 and: [(memory at: 2) = 0]] whileFalse: [| s | + s := self stringFromMemory: memory. + strings add: s. + memory := memory + (s size + 1 * 2)]. + ^strings +! ! + + diff --git a/modules/Kernel/WideSymbol.Class.st b/modules/Kernel/WideSymbol.Class.st new file mode 100644 index 00000000..34ee0acb --- /dev/null +++ b/modules/Kernel/WideSymbol.Class.st @@ -0,0 +1,152 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #WideSymbol category: #Kernel! +Symbol subclass: #WideSymbol + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!WideSymbol commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!WideSymbol methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aString + ^UTF16 current isString: self lessThanOrEqualTo: aString +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asByteCharacters + | n result | + n := self size. + result := Symbol new: n. + 1 to: n do: [:i | | code char | + code := self codeAt: i. + char := code < 256 ifTrue: [code] ifFalse: [$? asInteger]. + result byteAt: i put: char]. + ^result +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asLowercase + ^UTF16 current lowercaseOf: self +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asString + | n string | + n := self size. + string := WideString new: n. + ^string replaceFrom: 1 to: n with: self +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asUppercase + ^UTF16 current uppercaseOf: self +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asWideSymbol + ^self +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + | cp | + cp := self checkIndex: index; codeAt: index. + ^Character value: cp +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index putCode: codePoint + ^self + checkIndex: index; + uLongAtOffset: index - 1 * 4 put: codePoint +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: index + | cp | + cp := self codeAt: index. + ^Character value: cp +! ! + +!WideSymbol methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicSize + ^self _size +! ! + +!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +codeAt: index + ^self uLongAtOffset: index - 1 * 4 +! ! + +!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isByteCompliant + ^false +! ! + +!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWide + ^true +! ! + +!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWideSymbol + ^true +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self _size // 4 +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^self size * 4 +! ! + +!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +species + ^WideString +! ! + +!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +td1 + | m td1 | + m := self size. + td1 := Dictionary new: m. + m to: 1 by: -1 do: [:i | | code | + code := self uLongAtOffset: i - 1 * 4. + td1 at: code + 1 ifAbsentPut: [m - i + 1]]. + ^td1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WideSymbol class' category: #Kernel! +WideSymbol class + instanceVariableNames: ''! + +!WideSymbol class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +findInterned: aString + | symbol string | + string := aString reduced. + string == aString ifFalse: [^super findInterned: string]. + symbol := aString bytes changeClassTo: self. + ^SymbolTable lookup: symbol +! ! + +!WideSymbol class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +intern: aString + | symbol canonical | + aString isByteCompliant ifTrue: [^aString reduced asSymbol]. + symbol := aString bytes changeClassTo: self. + canonical := SymbolTable lookup: symbol. + canonical == nil ifTrue: [^SymbolTable add: symbol]. + ^canonical +! ! + + diff --git a/modules/Kernel/WriteStream.Class.st b/modules/Kernel/WriteStream.Class.st new file mode 100644 index 00000000..61b4c116 --- /dev/null +++ b/modules/Kernel/WriteStream.Class.st @@ -0,0 +1,232 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #WriteStream category: #Kernel! +Stream subclass: #WriteStream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!WriteStream commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!WriteStream methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +<< anObject + | string | + string := anObject isString + ifTrue: [anObject] + ifFalse: [anObject printString]. + self nextPutAll: string +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +alignTo: boundary + | null | + null := self + collectorOfSize: boundary - (self position \\ boundary) \\ boundary. + self nextPutAll: null +! ! + +!WriteStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +collectorOfSize: anInteger + self subclassResponsibility +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +cr + self nextPutAll: self eol +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +crlf + self nextPutAll: String crlf +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +crtab + self crtab: 1 +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +crtab: n + self cr; tab: n +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +flush + +! ! + +!WriteStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBinary + ^false +! ! + +!WriteStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isOpen + ^true +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +next: anInteger put: anObject + anInteger timesRepeat: [self nextPut: anObject]. + ^anObject +! ! + +!WriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextBytePut: byte + | token | + (byte between: 0 and: 255) ifFalse: [self error: 'ilegal number']. + token := self isBinary ifTrue: [byte] ifFalse: [byte asCharacter]. + self nextPut: token. + ^byte +! ! + +!WriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextBytesPut: aByteArray + | token | + token := self isBinary + ifTrue: [aByteArray] + ifFalse: [aByteArray asByteArray asString]. + self putBytesFrom: token. + ^aByteArray +! ! + +!WriteStream methodsFor: 'chunk format' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextChunkPut: aString + aString printChunkOn: self +! ! + +!WriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextFloatPut: aFloat + ^self nextPutAll: aFloat asByteArray +! ! + +!WriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextInt64Put: anInteger + | n | + (anInteger < -16r8000000000000000 or: [ anInteger >= 16r8000000000000000 ]) + ifTrue: [ self error: 'outside 64-bit integer range' ]. + n := anInteger < 0 + ifTrue: [ 16r10000000000000000 + anInteger ] + ifFalse: [ anInteger ]. + 8 to: 1 by: -1 do: [:i | self nextPut: (n byteAt: i)] +! ! + +!WriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextLongPut: anInteger + | bytes | + bytes := ByteArray new: 4. + bytes longAtOffset: 0 put: anInteger. + self putBytesFrom: bytes +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextPut: anObject + self subclassResponsibility +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextPutAll: aCollection + aCollection do: [:element | self nextPut: element] +! ! + +!WriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextStringPut: aString + self nextULongPut: aString size; nextPutAll: aString +! ! + +!WriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextULargePut: anInteger + self isBinary + ifTrue: [ + 1 to: 8 do: [:i | | bi | + bi := anInteger at: i. + self nextPut: bi]] + ifFalse: [ + 1 to: 8 do: [:i | | bi | + bi := anInteger at: i. + self nextPut: bi asCharacter]] +! ! + +!WriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextULongPut: anInteger + self isBinary + ifTrue: [ + 1 to: 4 do: [:i | | bi | + bi := anInteger at: i. + self nextPut: bi]] + ifFalse: [ + 1 to: 4 do: [:i | | bi | + bi := anInteger at: i. + self nextPut: bi asCharacter]] +! ! + +!WriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextUShortPut: anInteger + | bytes | + bytes := ByteArray new: 2. + bytes uShortAtOffset: 0 put: anInteger. + self putBytesFrom: bytes +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextUTF8Put: aString + aString do: [:ch | ch storeUTF8On: self] +! ! + +!WriteStream methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +print: anObject + anObject isString ifTrue: [^self nextPutAll: anObject]. + anObject isCharacter ifTrue: [^self nextPut: anObject]. + anObject printOn: self +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +putBytesFrom: aByteArray + self putBytesFrom: aByteArray from: 1 to: aByteArray sizeInBytes +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +putBytesFrom: aByteArray from: start to: stop + self subclassResponsibility +! ! + +!WriteStream methodsFor: 'marshalling' stamp: 'KenD 28/Jun/2026 13:27:38'! +putInteger: anInteger + anInteger < 128 + ifTrue: [self nextBytePut: anInteger] + ifFalse: [self + nextBytePut: anInteger \\ 128 + 128; + putInteger: anInteger // 128] +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +show: aString + self nextPutAll: aString +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +space + self nextPut: Space +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tab + self nextPut: Tab +! ! + +!WriteStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tab: n + n timesRepeat: [self tab] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WriteStream class' category: #Kernel! +WriteStream class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/WriteStringStream.Class.st b/modules/Kernel/WriteStringStream.Class.st new file mode 100644 index 00000000..867a89dc --- /dev/null +++ b/modules/Kernel/WriteStringStream.Class.st @@ -0,0 +1,45 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #WriteStringStream category: #Kernel! +InternalWriteStream subclass: #WriteStringStream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!WriteStringStream commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!WriteStringStream methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:38'! +beWide + super beWide. + limit := contents size + +! ! + +!WriteStringStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextPut: aCharacter + aCharacter isByteCharacter ifTrue: [^super nextPut: aCharacter]. + self beWide. + ^super nextPut: aCharacter +! ! + +!WriteStringStream methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextPutAll: aString + aString isString ifFalse: [^super nextPutAll: aString]. + contents isWideString = aString isWideString + ifTrue: [^super nextPutAll: aString]. + contents isWideString ifTrue: [^super nextPutAll: aString asWideString]. + self beWide. + ^super nextPutAll: aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WriteStringStream class' category: #Kernel! +WriteStringStream class + instanceVariableNames: ''! + + diff --git a/modules/Kernel/ZeroDivide.Class.st b/modules/Kernel/ZeroDivide.Class.st new file mode 100644 index 00000000..1cac3a55 --- /dev/null +++ b/modules/Kernel/ZeroDivide.Class.st @@ -0,0 +1,52 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ZeroDivide category: #Kernel! +ArithmeticError subclass: #ZeroDivide + instanceVariableNames: 'dividend' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ZeroDivide commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ZeroDivide methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +dividend + ^dividend +! ! + +!ZeroDivide methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +dividend: aNumber + dividend := aNumber +! ! + +!ZeroDivide methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + description := 'Floating Point exception when trying to divide by zero' +! ! + +!ZeroDivide methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isResumable + ^true +! ! + +!ZeroDivide methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +operation: aSymbol + super operation: aSymbol. + description := aSymbol == #'/' + ifTrue: ['Floating Point exception when trying to divide by zero'] + ifFalse: ['Divide by Zero exception in ''' , aSymbol , ''' operation'] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ZeroDivide class' category: #Kernel! +ZeroDivide class + instanceVariableNames: ''! + + +ZeroDivide initialize! + diff --git a/modules/LMR/AllocationZone.Class.st b/modules/LMR/AllocationZone.Class.st new file mode 100644 index 00000000..689216df --- /dev/null +++ b/modules/LMR/AllocationZone.Class.st @@ -0,0 +1,292 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #AllocationZone category: #Kernel! +Object subclass: #AllocationZone + instanceVariableNames: 'memory base nextFree limit spaces current next emptySpaces occupancy spaceSize spaceSizeShift' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!AllocationZone commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!AllocationZone methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocate: size + | oop | + oop := self allocateIfPossible: size. + oop _isSmallInteger ifTrue: [^oop]. + self _error: 'Out of memory in old space' +! ! + +!AllocationZone methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocateIfPossible: size + | oop | + oop := current allocateIfPossible: size. + oop _isSmallInteger ifTrue: [^oop]. + self bumpSpace. + ^current allocateIfPossible: size +! ! + +!AllocationZone methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +assureFree: anInteger + current availableBytes < anInteger ifTrue: [self bumpSpace] +! ! + +!AllocationZone methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +availableBytes + ^self usableBytes - self commitedBytes +! ! + +!AllocationZone methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +base + ^base +! ! + +!AllocationZone methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +base: anInteger + base := anInteger. + nextFree := anInteger +! ! + +!AllocationZone methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +build + | max | + max := self indexOfPointer: limit - 1. + occupancy := Array new: max withAll: 0. + spaces := CriticalArray new usePinnedAllocation; growTo: 1000. + emptySpaces := CriticalArray new usePinnedAllocation; growTo: 20. + self bumpSpace; bumpSpace +! ! + +!AllocationZone methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +bumpSpace + " + We first assign a new space, so that we don't get out of memory, + then we assure leaving another empty one for the next call + " + current := next. + emptySpaces isEmpty ifTrue: [self createEmptySpace]. + next := emptySpaces pop. + next commit: next reservedSize * 2. + self markAsFull: next. + ^next +! ! + +!AllocationZone methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +commitedBytes + ^spaces sum: [:s | s commitedBytes] +! ! + +!AllocationZone methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +createEmptySpace + | start s end | + nextFree == limit ifTrue: [self _error: 'Out of space in old zone']. + start := nextFree. + end := nextFree + spaceSize. + nextFree := end + spaceSize. + s := memory newSpace + base: start; + reservedLimit: end; + name: 'Old'. + spaces add: s. + emptySpaces add: s. + memory addSpace: s. + ^s +! ! + +!AllocationZone methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +currentSpace + ^current +! ! + +!AllocationZone methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +indexOfPointer: anInteger + ^(anInteger - base _bitShiftRight: spaceSizeShift) + 1 +! ! + +!AllocationZone methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +indexOfSpace: aGCSpace + ^self indexOfPointer: aGCSpace base +! ! + +!AllocationZone methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + spaceSize := 256 kbytes // 2. + spaceSizeShift := spaceSize highBit +! ! + +!AllocationZone methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +limit + ^limit +! ! + +!AllocationZone methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +limit: anInteger + limit := anInteger +! ! + +!AllocationZone methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +markAsFull: aGCSpace + " + We mark spaces as fully occupied so that + the GC doesn't see them as ready to be freed. + " + | index | + index := self indexOfSpace: aGCSpace. + occupancy at: index put: spaceSize * 2 +! ! + +!AllocationZone methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +markedDo: aBlock + spaces do: [:s | s markedDo: aBlock] +! ! + +!AllocationZone methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +memory: aMemory + memory := aMemory +! ! + +!AllocationZone methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectsDo: aBlock + spaces do: [:s | s objectsDo: aBlock] +! ! + +!AllocationZone methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +occupancy + ^occupancy +! ! + +!AllocationZone methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +occupiedBytes + ^occupancy sum +! ! + +!AllocationZone methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +recycleSpace: aGCSpace + emptySpaces add: aGCSpace +! ! + +!AllocationZone methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +regionCount + ^self indexOfPointer: nextFree - 1 +! ! + +!AllocationZone methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +regionIndexOf: object + | pointer | + pointer := object _asPointer. + pointer < base ifTrue: [^nil]. + pointer >= limit ifTrue: [^nil]. + ^self indexOfPointer: pointer +! ! + +!AllocationZone methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +regionSize + ^spaceSize +! ! + +!AllocationZone methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +releaseEvacuated: evacuated + 1 to: spaces size do: [:i | | space used recycle base size | + space := spaces at: i. + used := occupancy at: i. + recycle := (evacuated at: i) > 0 + or: [used == 0 and: [space commitedSize > 0]]. + recycle ifTrue: [ + base := space base. + size := space reservedSize. + space + nextFree: base; + commitedLimit: base; + softLimit: base. + Kernel os decommit: base * 2 size: size * 2 * 2. + self recycleSpace: space]] +! ! + +!AllocationZone methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +relocate: anInteger + base := base + anInteger. + nextFree := nextFree + anInteger. + limit := limit + anInteger +! ! + +!AllocationZone methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +reservedBytes + ^limit - base * 2 +! ! + +!AllocationZone methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +resetOccupancy + occupancy atAllPut: 0. + self markAsFull: current; markAsFull: next +! ! + +!AllocationZone methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +shallowCopyCommiting: object + | copy size space | + copy := current shallowCopyCommiting: object. + copy == nil ifFalse: [^copy]. + size := object _sizeInBytes. + size > Memory largeThreshold ifTrue: [ + space := memory createLargeSpace: size. + ^space shallowCopyCommiting: object]. + self bumpSpace. + ^current shallowCopyCommiting: object +! ! + +!AllocationZone methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +size + ^limit - base +! ! + +!AllocationZone methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +spaces + ^spaces +! ! + +!AllocationZone methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +unmarkedDo: aBlock + spaces do: [:s | s unmarkedDo: aBlock] +! ! + +!AllocationZone methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateRegionOccupancy: object + | index bytes | + index := self regionIndexOf: object. + index ifNil: [^self]. + bytes := occupancy at: index. + occupancy at: index put: bytes + object _sizeInBytes +! ! + +!AllocationZone methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +usableBytes + " + half of each reserved area is held for evacuation purposes only and not directly usable + " + ^self reservedBytes // 2 +! ! + +!AllocationZone methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +usedBytes + | count | + count := 0. + spaces do: [:s | count := count + s usedBytes]. + ^count +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'AllocationZone class' category: #Kernel! +AllocationZone class + instanceVariableNames: ''! + +!AllocationZone class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^super new initialize +! ! + + +AllocationZone initialize! + diff --git a/modules/LMR/Allocator.Class.st b/modules/LMR/Allocator.Class.st new file mode 100644 index 00000000..06dd8b26 --- /dev/null +++ b/modules/LMR/Allocator.Class.st @@ -0,0 +1,57 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #Allocator category: #Kernel! +Object subclass: #Allocator + instanceVariableNames: 'memory' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!Allocator commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!Allocator methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocate: anInteger + ^memory allocate: anInteger +! ! + +!Allocator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + memory := Memory current +! ! + +!Allocator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +memory: aMemory + memory := aMemory +! ! + +!Allocator methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:39'! +shallowCopy: array growingTo: newSize + | headerSize total buffer copy | + headerSize := 16. + total := headerSize + (newSize * WordSize). + buffer := self allocate: total. + copy := (buffer + headerSize _asPointer) _asObject. + copy _copyBasicHeaderFrom: array; _makeExtendedSize: newSize; _beUnseen. + 1 to: array _size do: [:index | | original | + original := array _basicAt: index. + copy _basicAt: index put: original]. + array _size + 1 to: newSize do: [:i | copy _basicAt: i put: nil]. + (array _isRemembered + or: [(memory isYoung: copy) not and: [memory pointsToYoungObjects: array]]) + ifTrue: [memory remember: copy] + ifFalse: [copy _beNotRemembered]. + ^copy +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Allocator class' category: #Kernel! +Allocator class + instanceVariableNames: ''! + + +Allocator initialize! + diff --git a/modules/LMR/CopyingCollector.Class.st b/modules/LMR/CopyingCollector.Class.st new file mode 100644 index 00000000..a32bf6c3 --- /dev/null +++ b/modules/LMR/CopyingCollector.Class.st @@ -0,0 +1,177 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #CopyingCollector category: #Kernel! +GarbageCollector subclass: #CopyingCollector + instanceVariableNames: 'fromSpace toSpace forwarders scan' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!CopyingCollector commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!CopyingCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +checkReachablePropertyOf: ephemeron + | key | + key := ephemeron _basicAt: 1. + key _isSmallInteger ifTrue: [^true]. + ^(self newspaceIncludes: key) not or: [key _hasBeenSeen] +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyOf: anObject + ^anObject _isProxy + ifTrue: [self proxeeOf: anObject] + ifFalse: [self doCopy: anObject] +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +fixReturnAddressIn: frame sized: size + | return method original moved | + return := frame _basicAt: 0. + method := frame _basicAt: size - 1. + original := method nativeCode code. + (self newspaceIncludes: original) ifTrue: [ + moved := self copyOf: original. + return := return _asSmallInteger - original _asSmallInteger + + moved _asSmallInteger. + frame _basicAt: 0 put: return _asNative] +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +followClosure + [scan < toSpace nextFree or: [self unscannedExternalsRemain]] + whileTrue: [self scanExternals; scanInternals; scanStacks] +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +forward: object to: copy + | index | + index := self forwardingIndexOf: object. + forwarders _asObject _basicAt: index put: copy. + object _beSeen +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +forwardersSize + ^self subclassResponsibility +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +forwardingIndexOf: anObject + ^self subclassResponsibility +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialContainerCapacity + ^(10 raisedTo: (self movableBytes log: 1000)) asInteger +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeForwarders + self subclassResponsibility +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeLocals + fromSpace := GCSpace copyFrom: memory from. + toSpace := GCSpace copyFrom: memory to. + scan := toSpace nextFree. + self initializeForwarders. + super initializeLocals +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +movableBytes + self subclassResponsibility +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +newspaceIncludes: object + ^self subclassResponsibility +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +proxeeOf: object + | index | + index := self forwardingIndexOf: object. + ^forwarders _asObject _basicAt: index +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +releaseLocals + fromSpace := toSpace := scan := nil. + super releaseLocals +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scan: current + current _isSpecial ifTrue: [self rememberSpecial: current]. + self + scanBehavior: current; + scan: current from: 1 to: current _strongPointersSize +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scan: current from: start to: limit + | index | + index := start. + [index <= limit] whileTrue: [ + self update: current at: index. + index := index + 1] +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanBehavior: current + self subclassResponsibility +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanExternals + self subclassResponsibility +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanInternals + [scan < toSpace nextFree] whileTrue: [| current | + current := scan _objectFromBasePointer. + self scan: current. + scan := current _nextBasePointer] +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanTopSlot: stackWrapper + self update: stackWrapper sp _asObject at: 1 +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +update: current at: index + ^self subclassResponsibility +! ! + +!CopyingCollector methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateWeak: weakContainer at: index + | object moved | + object := weakContainer _basicAt: index. + object _isSmallInteger ifTrue: [^self]. + (self newspaceIncludes: object) ifFalse: [^self]. + moved := object _hasBeenSeen + ifTrue: [self proxeeOf: object] + ifFalse: [tombstone]. + weakContainer _basicAt: index put: moved +! ! + +!CopyingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +workSpace + ^workSpace +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CopyingCollector class' category: #Kernel! +CopyingCollector class + instanceVariableNames: ''! + + diff --git a/modules/LMR/CriticalArray.Class.st b/modules/LMR/CriticalArray.Class.st new file mode 100644 index 00000000..f597144c --- /dev/null +++ b/modules/LMR/CriticalArray.Class.st @@ -0,0 +1,187 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #CriticalArray category: #Kernel! +SequenceableCollection subclass: #CriticalArray + instanceVariableNames: 'size contents allocator writeBarrier' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!CriticalArray commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!CriticalArray methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +add: object + size = contents _size ifTrue: [self grow]. + size := size + 1. + self at: size put: object +! ! + +!CriticalArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocator + ^allocator +! ! + +!CriticalArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocator: anAllocator + allocator := anAllocator +! ! + +!CriticalArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: index + ^contents _basicAt: index +! ! + +!CriticalArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: index put: anObject + ^writeBarrier + ifTrue: [contents objectAtValid: index put: anObject] + ifFalse: [contents _basicAt: index put: anObject] +! ! + +!CriticalArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +contents + ^contents +! ! + +!CriticalArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +contents: collection + contents := collection +! ! + +!CriticalArray methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +do: aBlock + 1 to: self size do: [:index | | element | + element := self at: index. + aBlock value: element] +! ! + +!CriticalArray methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +grow + self growTo: contents _size * 2 +! ! + +!CriticalArray methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +growTo: n + | expanded | + contents _size >= n ifTrue: [^self]. + expanded := allocator shallowCopy: contents growingTo: n. + expanded ifNil: [self _error: 'Could not copy critical array contents']. + contents := expanded +! ! + +!CriticalArray methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +ignoreWriteBarrier + writeBarrier := false +! ! + +!CriticalArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +includes: anObject + 1 to: size do: [:i | anObject = (contents at: i) ifTrue: [^true]]. + ^false +! ! + +!CriticalArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +includesIdentical: anObject + 1 to: size do: [:i | anObject == (contents at: i) ifTrue: [^true]]. + ^false +! ! + +!CriticalArray methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + size := 0. + writeBarrier := true. + contents := #(). + allocator := Allocator new memory: Memory current +! ! + +!CriticalArray methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isEmpty + ^size = 0 +! ! + +!CriticalArray methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +pop + | answer | + answer := self at: size. + contents _basicAt: size put: nil. + size := size - 1. + ^answer +! ! + +!CriticalArray methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:39'! +postCopy + super postCopy. + contents := contents copy +! ! + +!CriticalArray methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +push: object + ^self add: object +! ! + +!CriticalArray methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +remove: anObject ifAbsent: aBlock + 1 to: size do: [:i | + anObject == (contents at: i) ifTrue: [ + self removeIndex: i. + ^anObject]]. + ^aBlock value +! ! + +!CriticalArray methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeIndex: anInteger + contents + replaceFrom: anInteger + to: size - 1 + with: contents + startingAt: anInteger + 1; + at: size put: nil. + size := size - 1 +! ! + +!CriticalArray methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +reset + 1 to: self size do: [:i | contents _basicAt: i put: nil]. + size := 0 +! ! + +!CriticalArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +size + ^size +! ! + +!CriticalArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +size: anInteger + size := anInteger +! ! + +!CriticalArray methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:39'! +unsafeAdd: anObject + size = contents _size ifTrue: [self grow]. + size := size + 1. + self unsafeAt: size put: anObject +! ! + +!CriticalArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +unsafeAt: index put: anObject + ^contents _basicAt: index put: anObject +! ! + +!CriticalArray methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +usePinnedAllocation + allocator := PinnedAllocator new +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CriticalArray class' category: #Kernel! +CriticalArray class + instanceVariableNames: ''! + + +CriticalArray initialize! + diff --git a/modules/LMR/CriticalStack.Class.st b/modules/LMR/CriticalStack.Class.st new file mode 100644 index 00000000..dc8beadd --- /dev/null +++ b/modules/LMR/CriticalStack.Class.st @@ -0,0 +1,110 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #CriticalStack category: #Kernel! +SequenceableCollection subclass: #CriticalStack + instanceVariableNames: 'head limit top buffers bufferIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!CriticalStack commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!CriticalStack methodsFor: 'adding/removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addBuffer: size + | address | + address := Kernel os reserveAndCommit: size * WordSize. + buffers + push: size; + push: address // 2 +! ! + +!CriticalStack methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: anInteger + ^self errorNotIndexable +! ! + +!CriticalStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +buffers: aCriticalArray initialSize: anInteger + buffers := aCriticalArray. + self addBuffer: anInteger. + top := 0. + bufferIndex := 2. + head := buffers at: bufferIndex. + limit := anInteger +! ! + +!CriticalStack methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +grow + bufferIndex = buffers size ifTrue: [self addBuffer: limit * 2]. + bufferIndex := bufferIndex + 2. + head := buffers at: bufferIndex. + limit := buffers at: bufferIndex - 1. + top := 0 +! ! + +!CriticalStack methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isEmpty + ^top = 0 and: [bufferIndex = 2] +! ! + +!CriticalStack methodsFor: 'adding/removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pop + | answer | + top = 0 ifTrue: [self shrink]. + answer := head _asObject _basicAt: top. + top := top - 1. + ^answer +! ! + +!CriticalStack methodsFor: 'adding/removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +push: anObject + top = limit ifTrue: [self grow]. + top := top + 1. + ^head _asObject _basicAt: top put: anObject +! ! + +!CriticalStack methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:39'! +release + 2 to: buffers size by: 2 do: [:i | | address | + address := buffers at: i. + Kernel os release: address * 2]. + buffers reset +! ! + +!CriticalStack methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +reset + [buffers size > 2] whileTrue: [| address | + address := buffers pop. + buffers pop. + Kernel os release: address * 2]. + bufferIndex := 2. + head := buffers at: bufferIndex. + limit := buffers at: bufferIndex - 1. + top := 0 +! ! + +!CriticalStack methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +shrink + bufferIndex < 2 ifTrue: [self error: 'cannot shrink empty stack']. + bufferIndex := bufferIndex - 2. + head := buffers at: bufferIndex. + limit := top := buffers at: bufferIndex - 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CriticalStack class' category: #Kernel! +CriticalStack class + instanceVariableNames: ''! + +!CriticalStack class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +emptyReserving: anInteger + | buffers | + buffers := CriticalArray new growTo: 40. + ^self new buffers: buffers initialSize: anInteger +! ! + + diff --git a/modules/LMR/DispatchSite.Class.st b/modules/LMR/DispatchSite.Class.st new file mode 100644 index 00000000..b6a479a9 --- /dev/null +++ b/modules/LMR/DispatchSite.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #DispatchSite category: #Kernel! +Object subclass: #DispatchSite + instanceVariableNames: 'instructions token cache tally format' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!DispatchSite commentStamp: '' prior: 0! + + Copyright (c) 2022 Quorum Software. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'DispatchSite class' category: #Kernel! +DispatchSite class + instanceVariableNames: ''! + + diff --git a/modules/LMR/EdenCollector.Class.st b/modules/LMR/EdenCollector.Class.st new file mode 100644 index 00000000..4870d278 --- /dev/null +++ b/modules/LMR/EdenCollector.Class.st @@ -0,0 +1,417 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #EdenCollector category: #Kernel! +CopyingCollector subclass: #EdenCollector + instanceVariableNames: 'oldZone edenSpace youngBase youngLimit rememberedSet rememberedNext' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!EdenCollector commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +aboutToSaveImage + Kernel os release: forwarders * 2. + forwarders := nil +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +checkEphemeron: ephemeron + | key | + key := ephemeron key. + (toSpace includes: key) ifTrue: [self _error: 'Re-tracing ephemeron']. + (ephemeron registry == ProcessLMRStack registeredInstances + andNot: [key class == ProcessLMRStack]) + ifTrue: [self _error: 'Invalid ephemeron'] +! ! + +!EdenCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyRescuedEphemerons + | copy contents | + copy := toSpace shallowCopyCommiting: rescuedEphemerons. + copy ifNil: [copy := oldZone shallowCopyCommiting: rescuedEphemerons]. + rescuedEphemerons := copy. + contents := toSpace shallowCopyCommiting: rescuedEphemerons contents. + ^contents ifNil: [oldZone shallowCopyCommiting: rescuedEphemerons contents] +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyToOld: object + | copy | + copy := oldZone shallowCopyCommiting: object. + copy == nil + ifTrue: [self _error: 'Could not copy young object to old space']. + (self shouldBeRememberedWhenTenuring: object) ifTrue: [self remember: copy]. + self forward: object to: copy. + ^copy +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyToTo: object + | copy | + copy := toSpace shallowCopyCommiting: object. + copy == nil ifTrue: [^self copyToOld: object]. + copy _beSecondGeneration. + self forward: object to: copy. + ^copy +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +doCollect + self rememberOldStacks; purgeRememberedSet. + super doCollect. + self restoreRememberedSet; swapMemoryFromAndTo +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +doCopy: object + ^object _isSecondGeneration + ifTrue: [self copyToOld: object] + ifFalse: [self copyToTo: object] +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +followRememberedAt: index + | object | + object := rememberedSet at: index. + (self newspaceIncludes: object) + ifTrue: [self _error: 'Young object found in remembered set']. + self scanRemembered: object +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +forwardersSize + ^edenSpace commitedLimit - memory youngBase * 2 +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +forwardingIndexOf: anObject + ^(anObject _asPointer - youngBase bitShift: 0 - WordSizeShift + 1) + 1 +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasToPurge: object + | class | + class := object class. + (class == ProcessLMRStack and: [self newspaceIsRefererredByStack: object]) + ifTrue: [^false]. + ^(self newspaceIncludes: object) + or: [(self newspaceIsReferredBy: object) not] +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeForwarders + | offset result base size | + forwarders ifNil: [ + forwarders := Kernel os reserve: youngLimit - youngBase * 2. + forwarders = 0 + ifTrue: [self _error: 'GC could not reserve space for young forwarders']. + forwarders := forwarders // 2]. + offset := forwarders - youngBase. + fromSpace commitedSize > 0 ifTrue: [ + base := fromSpace base + offset * 2. + size := fromSpace commitedSize * 2. + result := Kernel os commit: size at: base. + result = 0 + ifTrue: [self + _error: 'GC could not commit space for from-space forwarders']. + (base // 2) _asObject _nilSlots: size // WordSize]. + base := edenSpace base + offset * 2. + size := edenSpace commitedSize * 2. + result := Kernel os commit: size at: base. + result = 0 + ifTrue: [self + _error: 'GC could not commit space for eden-space forwarders']. + (base // 2) _asObject _nilSlots: size // WordSize +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeLocals + | remember | + remember := RememberedSet new initialize: 1024. + memory rememberedSet: remember. + rememberedNext := 1. + super initializeLocals +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +movableBytes + ^fromSpace commitedSize + edenSpace commitedSize * 2 +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +newspaceIncludes: object + ^object _asPointer between: youngBase and: youngLimit +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +newspaceIsRefererredByStack: aProcessStack + aProcessStack isValid ifFalse: [^false]. + aProcessStack isActive ifTrue: [self updateStackPointer: aProcessStack]. + aProcessStack objectsDo: [:o | + (o _isSmallInteger not + and: [o _asPointer between: youngBase and: youngLimit]) + ifTrue: [^true]]. + ^false +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +newspaceIsReferredBy: object + | max slot | + object _isSmallInteger ifTrue: [^false]. + max := object _isBytes ifTrue: [0] ifFalse: [object _size]. + slot := object _longSlotAt: 0. + (slot _isSmallInteger not + and: [slot _asPointer between: youngBase and: youngLimit]) + ifTrue: [^true]. + 1 to: max do: [:i | + slot := object _basicAt: i. + (slot _isSmallInteger not + and: [slot _asPointer between: youngBase and: youngLimit]) + ifTrue: [^true]]. + ^false +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +postInitialize + rememberedSet := memory rememberedSet. + edenSpace := memory eden. + oldZone := memory old. + youngBase := memory youngBase. + youngLimit := memory youngLimit. + super postInitialize +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +purgeCurrentRememberedSet + " + In typical cases, the GC does not add any useful + object to the remembered set while collecting. + However, it sometimes does: for example, when + method used by gc is changed, the corresponding + send site in gc code will be flushed; during collection + the SS cache is updated and pointed to the (new) + code and remembered. In a case like that, the + addition to the remembered set should not be + forgotten (pun intended) after the GC pass finishes + " + | current | + current := memory rememberedSet. + 1 to: current size do: [:i | | remembered | + remembered := current at: i. + (workSpace includes: remembered) ifFalse: [rememberedSet add: remembered]]. + current size: 0 +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +purgeRememberedSet + | object kept | + kept := 0. + 1 to: rememberedSet size do: [:index | + object := rememberedSet at: index. + rememberedSet at: index put: nil. + (self hasToPurge: object) + ifFalse: [ + kept := kept + 1. + rememberedSet at: kept put: object] + ifTrue: [object _beNotRemembered]]. + rememberedSet size: kept +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +releaseLocals + " + we do not decommit unless we were using lots of memory, + because recommitting later can become a bottleneck + " + edenSpace commitedSize * 2 > 8 mbytes ifTrue: [Kernel os decommit: forwarders * 2]. + super releaseLocals +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +remember: anObject + anObject _beRemembered. + rememberedSet add: anObject +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberOldStacks + ProcessStack registeredInstances + do: [:stack | self rememberStackIfNeeded: stack] +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberStackIfNeeded: stack + stack _isRemembered ifTrue: [^self]. + (memory isYoung: stack) ifTrue: [^self]. + (self newspaceIsRefererredByStack: stack) ifFalse: [^self]. + rememberedSet add: stack _beRemembered +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +restoreRememberedSet + " + we must do a last scan to avoid missing objects remembered in the + lapse between the last scan cycle (just before handling ephemerons + and this point) + " + | current | + self scanRememberedSet. + current := memory rememberedSet. + memory rememberedSet: rememberedSet. + current release +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanBehavior: current + | behavior moved | + behavior := current _longSlotAt: 0. + behavior _isSmallInteger ifTrue: [^behavior]. + (self newspaceIncludes: behavior) ifTrue: [ + moved := self copyOf: behavior. + ^current _longSlotAt: 0 put: moved]. + ^behavior +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanExternals + self scanRememberedSet +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanRemembered: current + current _isSpecial ifTrue: [self rememberSpecial: current]. + self + scanBehavior: current; + scanRemembered: current from: 1 to: current _strongPointersSize +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanRemembered: current from: start to: limit + | index | + index := start. + [index <= limit] whileTrue: [ + self updateRemembered: current at: index. + index := index + 1] +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanRememberedSet + [ + self purgeCurrentRememberedSet. + rememberedNext <= rememberedSet size] + whileTrue: [ + self followRememberedAt: rememberedNext. + rememberedNext := rememberedNext + 1] +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanThreadLocalStorage: thread + thread localStorageIndices do: [:index | | object moved | + object := thread tlsAt: index. + object _isSmallInteger ifTrue: [^object]. + (self newspaceIncludes: object) ifTrue: [ + moved := self copyOf: object. + thread tlsAt: index put: moved]] +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeRememberedWhenTenuring: object + ^(memory pointsToYoungObjects: object) + or: [object _isSpecial and: object class == ProcessLMRStack] +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +swapMemoryFromAndTo + " + self validate. + " + edenSpace wipeOut; reset; leaveDispenseSpace: 0x4000 _asPointer. + memory from wipeOut; copyFrom: toSpace. + memory to copyFrom: fromSpace; reset +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +unmarkAll + +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +unscannedExternalsRemain + ^rememberedNext <= rememberedSet size +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +update: current at: index + " + fetch the object and copy it if needed. `current` MUST be in + eden or from (never in to nor old spaces) + " + | object moved | + object := current _basicAt: index. + object _isSmallInteger ifTrue: [^object]. + (self newspaceIncludes: object) ifFalse: [^object]. + (toSpace includes: object) + ifTrue: [self _error: 'GC is trying to update an object in to-space']. + moved := self copyOf: object. + ^current _basicAt: index put: moved +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateRemembered: current at: index + " + only objects in remembered set might have been updated and have + pointers to young area in _to_ space. Therefore, we don't consider it + an error that situation + " + | object moved | + object := current _basicAt: index. + object _isSmallInteger ifTrue: [^object]. + (self newspaceIncludes: object) ifFalse: [^object]. + ^(toSpace includes: object) ifTrue: [object] ifFalse: [ + moved := self copyOf: object. + current _basicAt: index put: moved] +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +validate + " + check that no slot has been left pointing to + wiped out space (anything in new space not pointing to to). + " + memory spaces do: [:space | + (space !!= memory from and: [space !!= edenSpace and: [space !!= workSpace]]) + ifTrue: [space objectsDo: [:obj | self validate: obj]]] +! ! + +!EdenCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +validate: anObject + " + Check that no slot has been left pointing to wiped out space (anything in new space not pointing to toSpace). + " + | behavior | + behavior := anObject _longSlotAt: 0. + ((self newspaceIncludes: behavior) andNot: [toSpace includes: behavior]) + ifTrue: [anObject _error: 'A young object was left outside of to-space']. + 1 to: anObject _pointersSize do: [:i | | slot | + slot := anObject _basicAt: i. + (slot _isSmallInteger not + and: [(self newspaceIncludes: slot) andNot: [toSpace includes: slot]]) + ifTrue: [anObject _error: 'A young object was left outside of to-space']] +! ! + +!EdenCollector methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +workSpaceSize + ^self forwardersSize +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'EdenCollector class' category: #Kernel! +EdenCollector class + instanceVariableNames: ''! + + diff --git a/modules/LMR/GCSpace.Class.st b/modules/LMR/GCSpace.Class.st new file mode 100644 index 00000000..0c22b0c1 --- /dev/null +++ b/modules/LMR/GCSpace.Class.st @@ -0,0 +1,600 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #GCSpace category: #Kernel! +Object subclass: #GCSpace + instanceVariableNames: 'base nextFree softLimit commitedLimit reservedLimit prevBase memory name' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!GCSpace commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!GCSpace methodsFor: 'enumeration' stamp: 'KenD 28/Jun/2026 13:27:39'! +addInstancesOf: aSpecies into: result + " + remember not to create ANY objects here + " + | objectBase object end | + objectBase := base. + end := nextFree. + [objectBase < end] whileTrue: [ + object := objectBase _objectFromBasePointer. + objectBase := object _nextBasePointer. + object == result ifTrue: [^self]. + object class == aSpecies ifTrue: [result add: object]] +! ! + +!GCSpace methodsFor: 'enumeration' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMarkedInstancesOf: aSpecies into: result + " + remember not to create ANY objects here + " + | objectBase object end | + objectBase := base. + end := nextFree. + [objectBase < end] whileTrue: [ + object := objectBase _objectFromBasePointer. + objectBase := object _nextBasePointer. + object == result ifTrue: [^self]. + (object _hasBeenSeen and: [object class == aSpecies]) + ifTrue: [result add: object]] +! ! + +!GCSpace methodsFor: 'enumeration' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMarkedReferencesTo: anObject into: aCollection + | next object end | + next := base. + end := nextFree. + [next < end] whileTrue: [| index limit | + object := next _objectFromBasePointer. + index := 1. + limit := object _strongPointersSize. + object _hasBeenSeen ifTrue: [ + [index <= limit] whileTrue: [| ivar | + ivar := object _basicAt: index. + ivar == anObject ifTrue: [ + aCollection add: object. + index := limit]. + index := index + 1]]. + next := object _nextBasePointer] +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +address: address size: size + | p | + p := address // 2. + ^self + base: p; + reservedLimit: p + (size // 2) +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocateCommittingIfNeeded: size + | answer | + " mutex _busyWait." + answer := self lockedAllocateCommittingIfNeeded: size. + " mutex _release." + ^answer +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocateIfPossible: size + | answer | + " mutex _busyWait." + answer := self lockedAllocateIfPossible: size. + " mutex _release." + ^answer +! ! + +!GCSpace methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:39'! +assert: aBoolean + aBoolean ifFalse: [self _halt] +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +available + ^softLimit - nextFree +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +availableBytes + ^self available * 2 +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +base + ^base +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +base: baseAddress + base := baseAddress. + nextFree ifNil: [nextFree := base]. + softLimit ifNil: [softLimit := base]. + commitedLimit ifNil: [commitedLimit := base] +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +commit: bytes + | newLimit result | + newLimit := commitedLimit + bytes _asPointer. + result := self commitSized: newLimit - base. + result == base + ifFalse: [self _error: 'GC space could not commit as requested']. + softLimit := nextFree max: newLimit - 16r4000 _asPointer. + commitedLimit := newLimit +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +commitAtLeast: bytes + | padding size | + padding := 16r8000. + size := bytes + padding - 1 bitAnd: 0 - padding. + self commit: size +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +commitedBytes + ^commitedLimit - base * 2 +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +commitedLimit + ^commitedLimit +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +commitedLimit: anInteger + commitedLimit := anInteger. + reservedLimit isNil ifTrue: [reservedLimit := anInteger]. + softLimit isNil ifTrue: [softLimit := anInteger] +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +commitedSize + ^commitedLimit - base +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +commitMoreMemory: anInteger + " + This method may temporarily switch allocation space to old, which + is guaranteed to have dispense space. This is needed to assure + there is space for the extra objects allocated by the commit ffi call. + " + | new padded old critical original | + new := anInteger + 16r8000 _asPointer. + new >= reservedLimit ifTrue: [^self]. + critical := CRITICAL. + CRITICAL := true. + padded := new bitAnd: -16r1000 _asPointer. + original := memory allocator. + original available < 16r1000 _asPointer ifTrue: [ + old := memory old. + self == old ifTrue: [self dispenseReservedSpace]. + memory allocator: old]. + (self commitSized: padded - base) == base + ifFalse: [self _error: 'GC space could not commit as requested']. + softLimit := padded - 16r4000 _asPointer. + commitedLimit := padded. + memory allocator: original. + CRITICAL := critical +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +commitSized: size + | result | + size = 0 ifTrue: [^base]. + result := Kernel os commit: size * 2 at: base * 2. + result = 0 ifTrue: [Kernel os lastError]. + ^result // 2 +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyFrom: space + softLimit := space softLimit. + base := space base. + commitedLimit := space commitedLimit. + reservedLimit := space reservedLimit. + nextFree := space nextFree. + memory := space memory +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +dataBase + ^base * 2 +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +dataBase: address size: anInteger + | p | + p := address // 2. + self + base: p; + commitedLimit: p + (anInteger // 2); + nextFree: self commitedLimit +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +dataSize + ^reservedLimit - base * 2 +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +decommitIfPossible: anInteger + | delta dispense limit min newsoft | + delta := anInteger bitAnd: -0x1000 _asPointer. + dispense := 64 kbytes. + limit := commitedLimit - delta. + min := base + 2 mbytes _asPointer. + commitedLimit <= min ifTrue: [^self]. + limit := limit max: min. + newsoft := limit - dispense. + newsoft < nextFree ifTrue: [^self]. + Kernel os decommit: limit * 2 size: delta * 2. + softLimit := newsoft. + commitedLimit := limit +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +dispenseReservedSpace + softLimit := commitedLimit +! ! + +!GCSpace methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:39'! +finalize + Kernel os release: base +! ! + +!GCSpace methodsFor: 'enumeration' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstObject + ^base _objectFromBasePointer +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +histogram + | sizes | + sizes := Dictionary new. + ^self histogramInto: sizes +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +histogramInto: sizes + self objectsDo: [:object | | size association | + size := object _bodySizeInBytes. + association := sizes associationAt: object class ifAbsent: nil. + association + ifNil: [sizes at: object class put: size] + ifNotNil: [association value: association value + size]]. + ^sizes +! ! + +!GCSpace methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +includes: anObject + ^anObject _isSmallInteger not + and: [anObject _asPointer between: base and: commitedLimit] +! ! + +!GCSpace methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +includesAddress: anInteger + ^anInteger between: base and: commitedLimit +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +increaseSoftLimit: anInteger + | available | + available := commitedLimit - softLimit. + available <= 0x8000 _asPointer ifTrue: [^false]. + softLimit := softLimit + (anInteger min: available - 0x4000 _asPointer). + ^true +! ! + +!GCSpace methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isReferredBy: object + | max | + object _isSmallInteger ifTrue: [^false]. + max := object _isBytes ifTrue: [0] ifFalse: [object _size]. + 0 to: max do: [:i | | slot | + slot := object _basicAt: i. + (slot _isSmallInteger not and: [self includes: slot]) ifTrue: [^true]]. + ^false +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +leaveDispenseSpace: anInteger + softLimit := commitedLimit - anInteger. + softLimit >= nextFree + ifFalse: [self _error: 'GC space was asked for too much dispensed space'] +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +lockedAllocateCommittingIfNeeded: size + " + take into account that committing more memory could cause + allocation, so after doing it we recalculate our answer + " + | answer next | + answer := nextFree. + next := answer + size _asPointer. + next <= softLimit ifTrue: [ + nextFree := next. + ^answer]. + self commitMoreMemory: next. + answer := nextFree. + next := answer + size _asPointer. + ^next <= softLimit + ifTrue: [ + nextFree := next. + answer] + ifFalse: [nil] +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +lockedAllocateIfPossible: size + | answer next | + answer := nextFree. + next := answer + size _asPointer. + next > softLimit ifTrue: [^nil]. + nextFree := next. + ^answer +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +make: anObject become: anotherObject + " + should use objectsDo:, but using blocks creates + new blockclosures, so we can't use blocks here + " + | objectBase object endOop | + objectBase := base. + endOop := nextFree. + [objectBase < endOop] whileTrue: [ + object := objectBase _objectFromBasePointer. + objectBase := object _nextBasePointer. + object behavior == anObject ifTrue: [object behavior: anotherObject]. + 1 to: object _pointersSize do: [:i | + (object _basicAt: i) == anObject + ifTrue: [object objectAtValid: i put: anotherObject]]] +! ! + +!GCSpace methodsFor: 'enumeration' stamp: 'KenD 28/Jun/2026 13:27:39'! +markedDo: aBlock + self + objectsDo: [:object | object _hasBeenSeen ifTrue: [aBlock value: object]] +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +memory + ^memory +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +memory: aMemory + memory := aMemory +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^name +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aString + name := aString +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextFree + ^nextFree +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextFree: anInteger + nextFree := anInteger +! ! + +!GCSpace methodsFor: 'enumeration' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectsDo: aBlock + | objectBase object endOop | + objectBase := base. + endOop := nextFree. + [objectBase < endOop] whileTrue: [ + object := objectBase _objectFromBasePointer. + objectBase := object _nextBasePointer. + aBlock value: object] +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +percentageOfCommitedUsed + ^self used * 100 // self commitedSize +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +percentageOfReservedUsed + ^self used * 100 // self reservedSize +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +prevBase + ^prevBase +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +prevBase: address + prevBase := address +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +prevOffset + ^base - prevBase +! ! + +!GCSpace methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: stream + | commited reserved used | + commited := (self commitedSize * 2 // 1024) printString , ' kb'. + reserved := (self reservedSize * 2 // 1024) printString , ' kb reserved'. + used := self percentageOfReservedUsed printString , '% used'. + name printOn: stream. + stream nextPutAll: ' [ ' , commited , ' (' , reserved , ') ' , used , ' ]' +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +relocate: offset + prevBase := base. + base := base + offset. + commitedLimit := commitedLimit + offset. + nextFree := nextFree + offset. + reservedLimit := reservedLimit + offset. + softLimit := softLimit + offset +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +relocatingSetUp + | reserved committed address offset limit | + reserved := reservedLimit - base * 2. + committed := commitedLimit - base * 2. + prevBase := base. + address := Kernel os reserve: reserved at: base * 2. + address = 0 ifTrue: [ + limit := prevBase < 4 gbytes ifTrue: [4 gbytes] ifFalse: [1 << 64]. + address := Kernel os reserve: reserved near: prevBase limit: limit. + address = 0 ifTrue: [Kernel os lastError]]. + base := address // 2. + offset := base - prevBase. + commitedLimit := commitedLimit + offset. + nextFree := nextFree + offset. + reservedLimit := reservedLimit + offset. + softLimit := softLimit + offset. + address := Kernel os commit: committed at: base * 2. + address = 0 ifTrue: [Kernel os lastError] +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +reservedBytes + ^reservedLimit - base * 2 +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +reservedLimit + ^reservedLimit +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +reservedLimit: anInteger + reservedLimit := anInteger +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +reservedSize + ^reservedLimit - base +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +reset + nextFree := base +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +resetSoftLimit: anInteger + softLimit := nextFree + anInteger min: commitedLimit +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +shallowCopy: object + | size extra allocation oop copy | + size := object _bodySizeInBytes. + extra := object _headerSizeInBytes. + allocation := self allocateIfPossible: extra + size. + allocation _isSmallInteger ifFalse: [^0]. + oop := allocation + extra _asPointer. + copy := oop _asObject. + copy + _copyHeaderSized: extra from: object; + _replaceFrom: 1 to: (size bitShift: 0 - WordSizeShift) with: object; + _beNotRemembered. + ^copy +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +shallowCopyCommiting: object + | size extra allocation oop copy | + size := object _bodySizeInBytes. + extra := object _headerSizeInBytes. + allocation := self allocateCommittingIfNeeded: extra + size. + allocation _isSmallInteger ifFalse: [^nil]. + oop := allocation + extra _asPointer. + copy := oop _asObject. + copy + _copyHeaderSized: extra from: object; + _replaceFrom: 1 to: (size bitShift: 0 - WordSizeShift) with: object; + _beNotRemembered. + ^copy +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +size + ^reservedLimit - base +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +softAvailable + ^softLimit - nextFree +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +softLimit + ^softLimit +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +softLimit: ptr + softLimit := ptr +! ! + +!GCSpace methodsFor: 'enumeration' stamp: 'KenD 28/Jun/2026 13:27:39'! +unmarkAll + self objectsDo: [:object | object _beUnseen] +! ! + +!GCSpace methodsFor: 'enumeration' stamp: 'KenD 28/Jun/2026 13:27:39'! +unmarkedDo: aBlock + self + objectsDo: [:object | object _hasBeenSeen ifFalse: [aBlock value: object]] +! ! + +!GCSpace methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +used + ^nextFree - base +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +usedBytes + ^nextFree - base * 2 +! ! + +!GCSpace methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +usedBytes: used + nextFree := base + (used / 2) +! ! + +!GCSpace methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +wipeOut + base _asObject _zeroSlots: (self used bitShift: 0 - WordSizeShift + 1) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'GCSpace class' category: #Kernel! +GCSpace class + instanceVariableNames: ''! + +!GCSpace class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyFrom: aGCSpace + ^self new copyFrom: aGCSpace +! ! + + diff --git a/modules/LMR/GarbageCollector.Class.st b/modules/LMR/GarbageCollector.Class.st new file mode 100644 index 00000000..3a4c5cf6 --- /dev/null +++ b/modules/LMR/GarbageCollector.Class.st @@ -0,0 +1,353 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #GarbageCollector category: #Kernel! +Object subclass: #GarbageCollector + instanceVariableNames: 'weakContainers uncheckedEphemerons unreachedEphemerons rescuedEphemerons tombstone memory stacks currentSP workSpace' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!GarbageCollector commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!GarbageCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +checkEphemeron: object + +! ! + +!GarbageCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +checkEphemerons + | done | + done := true. + [uncheckedEphemerons isEmpty] whileFalse: [| ephemeron | + ephemeron := uncheckedEphemerons pop. + (self checkReachablePropertyOf: ephemeron) + ifTrue: [ + self followEphemeronWeaks: ephemeron. + done := false] + ifFalse: [unreachedEphemerons unsafeAdd: ephemeron]]. + ^done +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +checkReachablePropertyOf: ephemeron + ^self subclassResponsibility +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +collect + | eden | + eden := memory eden. + self + resetWorkspace; + currentSpace: workSpace; + initializeLocals; + updateStackAndDoCollect; + currentSpace: eden; + releaseLocals +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyRescuedEphemerons + self subclassResponsibility +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +currentSpace: aSpace + memory eden: aSpace +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +doCollect + self followRoots; strenghtenAndMigrateEphemerons; scanWeakContainers +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +followClosure + self subclassResponsibility +! ! + +!GarbageCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +followEphemerons + [| done | + done := self followLiveEphemerons; rescueUnreacheableEphemerons. + done] whileFalse +! ! + +!GarbageCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +followEphemeronWeaks: ephemeron + self + scan: ephemeron from: 1 to: ephemeron _size; + followClosure +! ! + +!GarbageCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +followLiveEphemerons + | done | + [ + done := self checkEphemerons. + done] + whileFalse: [self swapUncheckedWithUnreached] +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +followRoots + self scanThreadLocalStorages; followClosure; followEphemerons +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialContainerCapacity + ^self subclassResponsibility +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeLocals + | size | + size := self initialContainerCapacity. + weakContainers := CriticalArray new growTo: size; ignoreWriteBarrier. + uncheckedEphemerons := CriticalArray new growTo: size; ignoreWriteBarrier. + unreachedEphemerons := CriticalArray new growTo: size; ignoreWriteBarrier. + rescuedEphemerons := CriticalArray new growTo: size; ignoreWriteBarrier. + stacks := CriticalArray new growTo: size; ignoreWriteBarrier +! ! + +!GarbageCollector methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +memory: aMemory + memory := aMemory. + self postInitialize +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +postInitialize + | size address | + size := self workSpaceSize. + address := Kernel os reserveAndCommit: size. + workSpace := memory newSpace address: address size: size. + workSpace + name: 'GC Work'; + commitedLimit: workSpace reservedLimit; + leaveDispenseSpace: 64 * 1024 // 2 +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +releaseLocals + " + The collector is reachable while tracing the object graph + and so my ivars. That shall not be a problem as the pointers + to either my workspace or either the young space are going + to be up-to-date until next GC (where the ivars are reseted + again). However, this adds innecesary tracing overhead. The + only object that needs moving is the ephemerons array, as it + can happen that rescueing ephemerons triggers a GC and the + array is overrun as it lives in the workspace. + " + memory queueEphemerons: rescuedEphemerons. + weakContainers := uncheckedEphemerons := unreachedEphemerons := rescuedEphemerons := nil. + stacks := nil. + Processor activeProcess stack unlock +! ! + +!GarbageCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberSpecial: object + | collection class | + class := object class. + collection := class == Ephemeron + ifTrue: [ + self checkEphemeron: object. + uncheckedEphemerons] + ifFalse: [class == ProcessLMRStack ifTrue: [stacks] ifFalse: [weakContainers]]. + collection unsafeAdd: object +! ! + +!GarbageCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +rescueEphemeron: ephemeron + self followEphemeronWeaks: ephemeron. + rescuedEphemerons unsafeAdd: ephemeron +! ! + +!GarbageCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +rescueUnreacheableEphemerons + | done | + done := unreachedEphemerons isEmpty. + unreachedEphemerons + do: [:ephemeron | self rescueEphemeron: ephemeron]; + reset. + ^done +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +resetWorkspace + workSpace reset +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scan: current from: start to: limit + self subclassResponsibility +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanFirstStackChunk: aProcessStack + | start end | + aProcessStack isActive + ifTrue: [self updateStackPointer: aProcessStack] + ifFalse: [self scanTopSlot: aProcessStack]. + start := aProcessStack sp + (WordSize * 2) _asPointer. + end := aProcessStack bp. + aProcessStack + nativeFramesDo: [:frame :size | self + scanNativeStackFrame: frame + sized: size] + startingAt: start + base: end +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanNativeStackFrame: framePointer sized: size + " + all code is pinned for now + self fixReturnAddressIn: framePointer _asObject sized: size. + " + self scanStackFrameObjects: framePointer sized: size +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanSpecialSlots: special + self scan: special from: 1 to: special _size +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanStack: aProcessStack + aProcessStack isValid ifFalse: [^self]. + aProcessStack isNative ifTrue: [self scanFirstStackChunk: aProcessStack]. + aProcessStack + framesBeneathCallbackDo: [:frame :nativeSize | self + scanNativeStackFrame: frame + sized: nativeSize] +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanStackFrameObjects: framePointer sized: size + self scan: framePointer _asObject from: 1 to: size +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanStacks + [stacks isEmpty] whileFalse: [| s | + s := stacks pop. + self scanSpecialSlots: s; scanStack: s] +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanThreadLocalStorage: thread + self subclassResponsibility +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanThreadLocalStorages + Thread registeredInstances + do: [:thread | self scanThreadLocalStorage: thread] +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanTopSlot: stackWrapper + self subclassResponsibility +! ! + +!GarbageCollector methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanWeakContainers + weakContainers + do: [:weakContainer | self updateWeakReferencesOf: weakContainer]; + reset +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +strenghtenAndMigrateEphemerons + " + Hereby the rescued critical array contents is moved to the old region. + As it may have grown after being traced, the contents could be unmarked. + If that happened, and the contents was copied to a large space, the memory + area would be incorrectly freed. + To avoid that from happening, we mark the contents as seen. + " + | contents | + contents := self copyRescuedEphemerons. + contents ifNil: [ + ^self + _error: 'Rescued ephemerons could not be copied outside of GC work space']. + contents _beSeen. + memory rememberIfNeeded: contents. + rescuedEphemerons + contents: contents; + do: [:ephemeron | ephemeron _beNotSpecial] +! ! + +!GarbageCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +swapUncheckedWithUnreached + | aux | + aux := uncheckedEphemerons. + uncheckedEphemerons := unreachedEphemerons. + unreachedEphemerons := aux +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateActiveStack + " + We must store the stack pointer in a different var + instead of trusting the active process. This happens + because the process might do an FFI call and update + it while collecting + " + | stack | + stack := ActiveProcess stack lock; updateBack: 1. + currentSP := stack sp +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateStackAndDoCollect + " + Here we assure that the current environment, stored in E register, + is saved in the stack. Then we update the stack pointers of the + stack wrapper. This assures that the environment is seen and + updated when tracing the active process stack. + " + [self updateActiveStack; doCollect] value +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateStackPointer: stackWrapper + | bp | + bp := (currentSP _asObject _basicAt: 1) _asPointer. + stackWrapper sp: currentSP; bp: bp +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateWeak: weakContainer at: index + self subclassResponsibility +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateWeakReferencesOf: weakContainer + 1 + to: weakContainer _size + do: [:index | self updateWeak: weakContainer at: index] +! ! + +!GarbageCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +workSpaceSize + ^self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'GarbageCollector class' category: #Kernel! +GarbageCollector class + instanceVariableNames: ''! + +!GarbageCollector class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aMemory + ^self new memory: aMemory +! ! + + diff --git a/modules/LMR/GarbageFirstCollector.Class.st b/modules/LMR/GarbageFirstCollector.Class.st new file mode 100644 index 00000000..7096377b --- /dev/null +++ b/modules/LMR/GarbageFirstCollector.Class.st @@ -0,0 +1,119 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #GarbageFirstCollector category: #Kernel! +NonMovingCollector subclass: #GarbageFirstCollector + instanceVariableNames: 'oldZone evacuated forwarderOffset countdown' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!GarbageFirstCollector commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!GarbageFirstCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyOf: anObject + | forwarder | + forwarder := anObject _asPointer + forwarderOffset. + ^forwarder _asObject _basicAt: 1 +! ! + +!GarbageFirstCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +evacuate: anObject + | copy forwarder | + copy := oldZone shallowCopyCommiting: anObject. + anObject _isRemembered ifTrue: [copy _beRemembered]. + forwarder := anObject _asPointer + forwarderOffset. + forwarder _asObject _basicAt: 1 put: copy. + ^copy +! ! + +!GarbageFirstCollector methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasReachedCountdown + ^countdown <= 0 +! ! + +!GarbageFirstCollector methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasToEvacuate: anObject + | index | + index := oldZone regionIndexOf: anObject. + ^index notNil and: [(evacuated at: index) > 0] +! ! + +!GarbageFirstCollector methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + countdown := 25 mbytes. + super initialize +! ! + +!GarbageFirstCollector methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeLocals + | threshold occupancy first max current headroom | + first := oldZone == nil. + oldZone := memory old. + forwarderOffset := oldZone regionSize. + threshold := (forwarderOffset * 2 * 0.8) asInteger. + occupancy := oldZone occupancy. + max := oldZone regionCount. + headroom := oldZone availableBytes * 9 // 10. + evacuated := ByteArray new: occupancy size. + first ifFalse: [ + current := oldZone currentSpace. + 1 to: max do: [:i | | used space size | + used := occupancy at: i. + (0 < used and: [used < threshold]) ifTrue: [ + space := oldZone spaces at: i. + used := space usedBytes. + (space !!== current and: [headroom > used]) ifTrue: [ + headroom := headroom - used. + size := space reservedSize. + Kernel os commit: size * 2 at: space base + size * 2. + evacuated at: i put: 1]]]]. + super initializeLocals +! ! + +!GarbageFirstCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +releaseLocals + oldZone releaseEvacuated: evacuated. + forwarderOffset := evacuated := nil. + self resetCountdown. + super releaseLocals +! ! + +!GarbageFirstCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +resetCountdown + | garbage bytes available young | + garbage := oldZone commitedBytes - oldZone occupiedBytes. + bytes := (oldZone usedBytes * 0.25) asInteger - garbage. + available := oldZone availableBytes * 9 // 10. + young := memory eden reservedBytes + memory from reservedBytes. + countdown := (25 mbytes max: bytes) min: available - young +! ! + +!GarbageFirstCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +tenured: anInteger + countdown := countdown - anInteger +! ! + +!GarbageFirstCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateWeak: weakContainer at: anInteger + | object updated | + object := weakContainer _basicAt: anInteger. + object _isSmallInteger ifTrue: [^self]. + object _hasBeenSeen + ifFalse: [^weakContainer _basicAt: anInteger put: tombstone]. + (self hasToEvacuate: object) ifFalse: [^self]. + updated := self copyOf: object. + weakContainer _basicAt: anInteger put: updated +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'GarbageFirstCollector class' category: #Kernel! +GarbageFirstCollector class + instanceVariableNames: ''! + + +GarbageFirstCollector initialize! + diff --git a/modules/LMR/GenGCPass.Class.st b/modules/LMR/GenGCPass.Class.st new file mode 100644 index 00000000..dbe70c8e --- /dev/null +++ b/modules/LMR/GenGCPass.Class.st @@ -0,0 +1,176 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #GenGCPass category: #Kernel! +Object subclass: #GenGCPass + instanceVariableNames: 'time oldSize youngSize cradled tenured rememberedBefore rememberedAfter rescued' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!GenGCPass commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cradled + ^cradled +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cradled: anInteger + cradled := anInteger +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +oldSize + ^oldSize +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +oldSize: anInteger + oldSize := anInteger +! ! + +!GenGCPass methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printCSVOn: aStream + aStream + print: time; + nextPutAll: ','; + nextPutAll: (youngSize / 1024.0 printFraction: 2); + nextPutAll: ','; + nextPutAll: (cradled / 1024.0 printFraction: 2); + nextPutAll: ','; + nextPutAll: (tenured / 1024.0 printFraction: 2); + nextPutAll: ','; + nextPutAll: (self survivalRate * 100 printFraction: 2); + nextPutAll: ','; + print: rememberedBefore; + nextPutAll: ','; + print: rememberedAfter; + nextPutAll: ','; + nextPutAll: (self throughput printFraction: 2); + nextPutAll: ','; + print: rescued +! ! + +!GenGCPass methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream + nextPutAll: 'GC run took '; + print: time; + nextPutAll: 'ms'; + cr; + nextPutAll: 'Young before: '; + nextPutAll: (youngSize / 1024.0 / 1024.0 printFraction: 2); + nextPutAll: 'mb'; + cr; + nextPutAll: 'Young after: '; + nextPutAll: (cradled / 1 mbytes printFraction: 2); + nextPutAll: 'mb'; + cr; + nextPutAll: 'Tenured: '; + nextPutAll: (tenured / 1 mbytes printFraction: 2); + nextPutAll: 'mb'; + cr; + nextPutAll: 'Survival rate: '; + nextPutAll: (self survivalRate * 100 printFraction: 2); + nextPutAll: '%'; + cr; + nextPutAll: 'Remembered before: '; + print: rememberedBefore; + cr; + nextPutAll: 'Remembered after: '; + print: rememberedAfter; + cr; + nextPutAll: 'Throughput: ~'; + nextPutAll: (self throughput printFraction: 2); + nextPutAll: 'mb/s'; + cr; + nextPutAll: 'Rescued '; + print: rescued; + nextPutAll: ' ephemerons.' +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberedAfter + ^rememberedAfter +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberedAfter: anInteger + rememberedAfter := anInteger +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberedBefore + ^rememberedBefore +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberedBefore: anInteger + rememberedBefore := anInteger +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +rescued + ^rescued +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +rescued: anInteger + rescued := anInteger +! ! + +!GenGCPass methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +survivalRate + ^cradled + tenured / youngSize asFloat +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +tenured + ^tenured +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +tenured: anInteger + tenured := anInteger +! ! + +!GenGCPass methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +throughput + " + in MBs per second + " + ^time = 0 + ifTrue: [0] + ifFalse: [cradled + tenured * 1000 / time mbytes asFloat] +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +time + ^time +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +time: anInteger + time := anInteger +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +youngSize + ^youngSize +! ! + +!GenGCPass methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +youngSize: anInteger + youngSize := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'GenGCPass class' category: #Kernel! +GenGCPass class + instanceVariableNames: ''! + + diff --git a/modules/LMR/GlobalDispatchCache.Class.st b/modules/LMR/GlobalDispatchCache.Class.st new file mode 100644 index 00000000..fb8f7e52 --- /dev/null +++ b/modules/LMR/GlobalDispatchCache.Class.st @@ -0,0 +1,198 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #GlobalDispatchCache category: #Kernel! +Object subclass: #GlobalDispatchCache + instanceVariableNames: 'contents' + classVariableNames: 'Current GlobalLookupCount' + poolDictionaries: '' + category: 'Kernel'! +!GlobalDispatchCache commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!GlobalDispatchCache methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: selector for: aBehavior + | index | + index := self indexOf: selector with: aBehavior. + ^self lookup: selector for: aBehavior startingAt: index +! ! + +!GlobalDispatchCache methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: aSymbol for: aBehavior put: aCompiledMethod + | index | + index := self indexOf: aSymbol with: aBehavior. + ^self startingAt: index for: aBehavior put: aCompiledMethod +! ! + +!GlobalDispatchCache methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicFlush: selector for: aBehavior + | index | + index := self indexOf: selector with: aBehavior. + self flush: selector for: aBehavior startingAt: index +! ! + +!GlobalDispatchCache methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicFlush: selector forSpecies: aSpecies + " + We avoid sending messages to aSpecies because it would + create a huge PIC. Instead we use undermessages. + " + | behavior subclasses | + behavior := aSpecies _basicAt: 2. + self basicFlush: selector for: behavior. + subclasses := self subclassesOf: aSpecies. + subclasses == nil ifFalse: [ + 1 to: subclasses size do: [:i | | subclass | + subclass := subclasses at: i. + subclass == nil ifFalse: [self basicFlush: selector forSpecies: subclass]]] +! ! + +!GlobalDispatchCache methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +flush + 1 to: contents _size do: [:i | contents _basicAt: i put: nil] +! ! + +!GlobalDispatchCache methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +flush: selector for: aBehavior startingAt: position + contents + _basicAt: position put: nil; + _basicAt: position + 2 put: nil; + _basicAt: position + 4 put: nil; + _basicAt: position + 6 put: nil; + _basicAt: position + 8 put: nil; + _basicAt: position + 10 put: nil; + _basicAt: position + 12 put: nil; + _basicAt: position + 14 put: nil +! ! + +!GlobalDispatchCache methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +flush: selector forSpecies: aSpecies + " + We avoid sending messages to aSpecies because it would + create a huge PIC. Instead we use undermessages. + " + (Object == aSpecies or: [ProtoObject == aSpecies or: [aSpecies == nil]]) + ifTrue: [^self flushAll: selector]. + self basicFlush: selector forSpecies: aSpecies +! ! + +!GlobalDispatchCache methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +flushAll: aSymbol + 1 to: contents _size by: 2 do: [:i | | method selector | + method := contents _basicAt: i. + method == nil ifFalse: [ + selector := method _basicAt: 4. + selector == aSymbol ifTrue: [contents _basicAt: i put: nil]]] +! ! + +!GlobalDispatchCache methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +indexOf: selector with: behavior + " + we always return odd values so that the table has + the next (even) index to store the cached value + " + | hash | + hash := (selector _basicHash bitXor: behavior _basicHash) bitAnd: 16rFFFF. + ^hash + hash + 1 +! ! + +!GlobalDispatchCache methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + contents := Array new: 16r20000 + (8 * 2) +! ! + +!GlobalDispatchCache methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookup: selector for: aBehavior startingAt: position + | index | + index := position. + 8 timesRepeat: [| method protocol | + method := contents _basicAt: index. + method == nil ifTrue: [^nil]. + protocol := contents _basicAt: index + 1. + (protocol == aBehavior and: [method selector == selector]) ifTrue: [ + method hasBeenFlushed + ifTrue: [ + contents + _basicAt: index + 1 put: nil; + _basicAt: index put: nil] + ifFalse: [^method]]. + index := index + 2]. + ^nil +! ! + +!GlobalDispatchCache methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupAndCache: aSymbol in: aBehavior + | method | + aBehavior hasInstanceBehavior + ifTrue: [^self _lookup: aSymbol in: aBehavior]. + method := self at: aSymbol for: aBehavior. + method == nil ifTrue: [ + GlobalLookupCount := GlobalLookupCount + 1. + method := self _lookup: aSymbol in: aBehavior. + self at: aSymbol for: aBehavior put: method]. + ^method +! ! + +!GlobalDispatchCache methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +startingAt: position for: aBehavior put: aCompiledMethod + | index | + index := position. + 8 timesRepeat: [| method | + method := contents _basicAt: index. + method == nil ifTrue: [ + contents objectAtValid: index put: aCompiledMethod. + ^contents objectAtValid: index + 1 put: aBehavior]. + index := index + 2]. + contents + objectAtValid: position put: aCompiledMethod; + objectAtValid: position + 1 put: aBehavior; + _basicAt: position + 2 put: nil; + _basicAt: position + 4 put: nil; + _basicAt: position + 6 put: nil; + _basicAt: position + 8 put: nil; + _basicAt: position + 10 put: nil; + _basicAt: position + 12 put: nil; + _basicAt: position + 14 put: nil +! ! + +!GlobalDispatchCache methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +subclassesOf: aSpecies + " + Optimized to avoid megamorphic sends + " + | metaclass subclasses class | + metaclass := aSpecies _size = 6. + ^metaclass + ifTrue: [ + class := aSpecies _basicAt: 6. + subclasses := class _basicAt: 7. + subclasses == nil ifFalse: [subclasses collect: [:c | c class]]] + ifFalse: [aSpecies _basicAt: 7] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'GlobalDispatchCache class' category: #Kernel! +GlobalDispatchCache class + instanceVariableNames: 'Current GlobalLookupCount'! + +!GlobalDispatchCache class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +current + ^Thread currentGlobalLookup ifNil: [Current] +! ! + +!GlobalDispatchCache class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +current: aCache + Current := aCache +! ! + +!GlobalDispatchCache class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +globalLookupCount + ^GlobalLookupCount +! ! + + +GlobalDispatchCache initialize! + diff --git a/modules/LMR/LMRModule.Class.st b/modules/LMR/LMRModule.Class.st new file mode 100644 index 00000000..bdea0ebe --- /dev/null +++ b/modules/LMR/LMRModule.Class.st @@ -0,0 +1,147 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #LMRModule category: #'Powerlang-Core-LMR'! +Module subclass: #LMRModule + instanceVariableNames: 'globals memory' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-LMR'! +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +globalNamed: aSymbol + | index | + index := self class indexOfGlobal: aSymbol. + ^globals at: index +! ! + +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +globalNamed: aSymbol put: anObject + | index | + index := self class indexOfGlobal: aSymbol. + globals at: index put: anObject +! ! + +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +globals + ^globals +! ! + +!LMRModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #Kernel -> #(ProcessStack ProtoObject SequenceableCollection WordSize). + #Kernel.LMR -> #(LMRProtoObject) + } +! ! + +!LMRModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeGlobalsWithStubs + | items | + globals := Array new: self class globalNames size. + + self globalNamed: #SmallIntegerBehavior put: SmallInteger instanceBehavior. + + items := Dictionary withAll: { + #Lookup -> (NativeCode new code: 'Lookup Placeholder'). + #LookupSuper -> (NativeCode new code: 'LookupSuper Placeholder'). + #DebuggableLookup -> (NativeCode new code: 'DebuggableLookup placeholder'). + #DebuggableLookupSuper -> (NativeCode new code: 'DebuggableLookupSuper placholder'). + #Invoke -> (NativeCode new code: 'Invoke placeholder'). + #Safepoint -> (NativeCode new code: 'SafepointCheck placeholder'). + #WriteBarrier -> (NativeCode new code: 'Write Barrier placeholder')}. + items + keysAndValuesDo: [ :key :placeholder | self globalNamed: key put: placeholder ] +! ! + +!LMRModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeMemory + | kernel | + kernel := GCSpace new. + kernel name: 'Kernel'. + memory := Memory new + addKernelSpace: kernel; + fromSpace: kernel; + eden: kernel +! ! + +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +invokeStub + ^(self globalNamed: #Invoke) code +! ! + +!LMRModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +justLoaded + super justLoaded. + SendSite initializeFormatFlags. + GlobalDispatchCache initialize. + self + initializeMemory; + initializeGlobalsWithStubs. +! ! + +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookup + ^self globalNamed: #Lookup +! ! + +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupDebuggableStub + ^(self globalNamed: #DebuggableLookup) code +! ! + +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupStub + ^(self globalNamed: #Lookup) code +! ! + +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupSuper + | index | + index := self class indexOfGlobal: #LookupSuper. + ^globals at: index +! ! + +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupSuperDebuggableStub + | index | + index := self class indexOfGlobal: #DebuggableLookupSuper. + ^(globals at: index) code +! ! + +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupSuperStub + | index | + index := self class indexOfGlobal: #LookupSuper. + ^(globals at: index) code +! ! + +!LMRModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +mapGlobal: aSymbol to: nativeCode + placeholder := self globalNamed: aSymbol. + placeholder code become: nativeCode code. + placeholder become: nativeCode. +! ! + +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +safepoint + ^(self globalNamed: #Safepoint) code +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LMRModule class' category: #'Powerlang-Core-LMR'! +LMRModule class + instanceVariableNames: ''! + +!LMRModule class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +globalNames + ^#(Lookup LookupSuper WriteBarrier Safepoint SmallIntegerBehavior Invoke DebuggableLookup DebuggableLookupSuper) +! ! + +!LMRModule class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +indexOfGlobal: aSymbol + ^self globalNames + indexOf: aSymbol + ifAbsent: [self error: 'global not found'] +! ! + + diff --git a/modules/LMR/Memory.Class.st b/modules/LMR/Memory.Class.st new file mode 100644 index 00000000..bd44efc1 --- /dev/null +++ b/modules/LMR/Memory.Class.st @@ -0,0 +1,944 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #Memory category: #Kernel! +Object subclass: #Memory + instanceVariableNames: 'spaces collectedSpaces genCollector pinnedSpace fromSpace toSpace oldZone meter edenSpace youngBase youngLimit rememberedSet inGC fullCollector unreachableEphemerons largeSpaces allocator' + classVariableNames: 'Current LargeThreshold CRITICAL' + poolDictionaries: '' + category: 'Kernel'! +!Memory commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Memory methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addKernelSpace: aSpace + spaces size: 1. + spaces contents at: 1 put: aSpace. + pinnedSpace := aSpace +! ! + +!Memory methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addKernelSpace: aSpace + spaces size: 1. + spaces contents at: 1 put: aSpace. + pinnedSpace := aSpace +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMarkedInstancesOf: aSpecies into: aCollection + | searched | + searched := spaces asOrderedCollection. + searched + do: [:space | space addMarkedInstancesOf: aSpecies into: aCollection] +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMarkedReferencesTo: anObject into: references + 1 to: spaces size do: [:i | | space | + space := spaces at: i. + space addMarkedReferencesTo: anObject into: references] +! ! + +!Memory methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addSpace: aSpace + oldZone ifNotNil: [oldZone assureFree: 1000]. + spaces add: aSpace +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +adjustSpaces + | stats rate committed limit delta | + stats := meter runs last. + rate := stats survivalRate. + committed := edenSpace commitedSize. + limit := edenSpace commitedLimit. + stats youngSize // 2 < (0.8 * committed) ifTrue: [^self]. + rate > 0.08 + ifTrue: [ + delta := committed * (rate * 4 + 1). + limit := limit + delta asInteger. + edenSpace commitMoreMemory: limit] + ifFalse: [ + delta := committed * (0.8 - rate / 2). + edenSpace decommitIfPossible: delta asInteger]. + edenSpace resetSoftLimit: 256 kbytes _asPointer +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +adjustYoungAreaBy: anInteger + youngBase := youngBase + anInteger. + youngLimit := youngLimit + anInteger +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +allDeadObjects + | collection | + collection := LinkedCollection new: 10000. + self + markedEvaluate: [spaces + do: [:space | space unmarkedDo: [:object | collection add: object]]]. + ^collection +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +allExistingInstancesOf: aSpecies + | instances marked | + instances := LinkedCollection new: 1024. + marked := spaces asOrderedCollection + remove: edenSpace; + remove: fromSpace; + yourself. + self + collectYoung; + critical: [ + marked do: [:s | s addMarkedInstancesOf: aSpecies into: instances]. + fromSpace addInstancesOf: aSpecies into: instances]. + ^instances +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +allInstancesOf: aSpecies + | instances | + instances := LinkedCollection new: 1024. + self markedEvaluate: [self addMarkedInstancesOf: aSpecies into: instances]. + ^instances +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocate: size + | oop | + oop := edenSpace allocateIfPossible: size. + oop _isSmallInteger ifTrue: [^oop]. + size > LargeThreshold ifTrue: [^self allocateLarge: size]. + ^self allocateCommitting: size +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocateCommitting: size + | oop grew | + grew := edenSpace increaseSoftLimit: 256 kbytes _asPointer. + CRITICAL ifFalse: [ + grew + ifTrue: [self rescueEphemerons] + ifFalse: [self collectYoung; collectOldIfTime]]. + oop := edenSpace allocateIfPossible: size. + oop _isSmallInteger ifTrue: [^oop]. + oop := allocator allocateIfPossible: size. + oop _isSmallInteger ifTrue: [^oop]. + ^oldZone allocate: size +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocateLarge: size + | space oop | + space := self createLargeSpace: size. + oop := space allocateIfPossible: size. + oop _isSmallInteger + ifFalse: [self + _error: 'Failed to allocate large space of size ' , size printString]. + ^oop +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocator + ^allocator +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocator: anObject + allocator := anObject +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +allRecyclableByteCount + | total | + total := 0. + self markedEvaluate: [ + spaces + do: [:space | space + unmarkedDo: [:object | total := total + object _sizeInBytes]]]. + ^total +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSubinstancesOf: aSpecies + | subinstances classes | + classes := aSpecies withAllSubclasses. + subinstances := LinkedCollection new: 1024. + self + markedEvaluate: [classes + do: [:cls | self addMarkedInstancesOf: cls into: subinstances]]. + ^subinstances +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +arenaBytes + ^oldZone size + edenSpace size + toSpace size * 2 +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +assureFree: size + edenSpace availableBytes < size ifTrue: [self collectYoung] +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +available + ^edenSpace availableBytes +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +baseAddress + ^spaces first dataBase +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +classMortalityHistogram + | histogram | + histogram := Dictionary new. + self markedEvaluate: [ + oldZone + unmarkedDo: [:object | histogram + at: object class + put: 1 + ifPresent: [:count | count + 1]]]. + ^histogram +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +collect + self collectYoung; collectOld +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +collectOld + self markedEvaluate: [] +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +collectOldIfTime + fullCollector hasReachedCountdown ifTrue: [self collectOld] +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +collectYoung + " + This method cannot have a home environment. Else, the environment + would be created before setting CRITICAL to true, and that may trigger + a infinite chain of recursive collectYoung sends + " + CRITICAL + ifTrue: [self + _error: 'Attempted to collect young memory during a critical section']. + CRITICAL := inGC := true. + SendSite ensureEnoughFreeCaches: 100. + self collectYoungMeasuring. + CRITICAL := inGC := false. + self adjustSpaces; rescueEphemerons +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +collectYoungMeasuring + meter + measure: [[ + self verifyMemory. + genCollector collect. + self verifyMemory] evaluateAtomically]. + fullCollector tenured: meter runs last tenured +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +commitedSize + ^spaces inject: 0 into: [:sum :space | sum + (space commitedSize * 2)] +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +createLargeSpace: size + " + We might be in GC, so the new GCSpace created must not be + placed in the current eden, which is the GC work space. We assure + that by using instead the current space in the old zone + " + | address space limit | + address := Kernel os reserveAndCommit: size. + address = 0 + ifTrue: [self + _error: 'Not enough memory to allocate ' , size printString , ' bytes']. + space := self newSpace address: address size: size. + limit := space reservedLimit. + space + name: 'Large'; + commitedLimit: limit; + softLimit: limit. + self addSpace: space. + largeSpaces add: space. + ^space +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +createPinnedSpace + " + We limit the pinned space to 32 bits so that + we can use for safely storing behaviors + " + | size address | + size := 4096 + 64 * 1024. + address := Kernel os reserveAndCommit: size near: 0 limit: 0x100000000. + pinnedSpace := self newSpace address: address size: size. + pinnedSpace + name: 'Pinned Object'; + commitedLimit: pinnedSpace reservedLimit; + leaveDispenseSpace: 1024. + self addSpace: pinnedSpace +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +createRememberedSet + rememberedSet := RememberedSet new initialize: 16 kbytes +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +createSpaces + | allocation eden | + allocation := self reserveSpaceSized: 256 * 1024 * 1024 commiting: 0. + fromSpace := self newSpaceAt: allocation base size: 16 * 1024 * 1024. + fromSpace name: 'From'. + toSpace := self newSpaceAt: fromSpace reservedLimit size: 16 * 1024 * 1024. + toSpace name: 'To'. + eden := self + newSpaceAt: toSpace reservedLimit + limit: allocation reservedLimit. + eden name: 'Eden'; commit: 4 mbytes. + youngBase := fromSpace base. + youngLimit := eden reservedLimit. + self addSpace: fromSpace; addSpace: eden. + oldZone := self reserveZoneSized: 12 * 1024 * 1024 * 1024 near: 0x100000000. + allocator := edenSpace := eden. + largeSpaces := CriticalArray new usePinnedAllocation; growTo: 1000. + unreachableEphemerons := CriticalArray new growTo: 1000 +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +critical: aBlock + ^[| prev result | + prev := CRITICAL. + CRITICAL := true. + result := aBlock value. + CRITICAL := prev. + result] evaluateAtomically +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +debugMode + ^false +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +eden + ^edenSpace +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +eden: aSpace + allocator := edenSpace := aSpace +! ! + +!Memory methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:39'! +edenCollector + ^genCollector +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +from + ^fromSpace +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSpace: aSpace + fromSpace := aSpace +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +fullClassMortalityHistogram + | histogram | + histogram := Dictionary new. + self markedEvaluate: [ + spaces do: [:space | + space + unmarkedDo: [:object | histogram + at: object class + put: 1 + ifPresent: [:count | count + 1]]]]. + ^histogram +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +garbageCollectTest2 + | space broken | + space := GCSpace copyFrom: fromSpace. + space nextFree: space softLimit. + broken := self collectYoung; objectsReferencing: space. + broken size > 0 ifTrue: [broken halt] +! ! + +!Memory methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasMarkedReferencesTo: aGCSpace in: aCollection + aCollection do: [:space | + space markedDo: [:object | + (aGCSpace includesAddress: object behavior) ifTrue: [^true]. + 1 to: object _pointersSize do: [:index | | reference | + reference := object _basicAt: index. + (aGCSpace includesAddress: reference) ifTrue: [^true]]]]. + ^false +! ! + +!Memory methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasReferencesToSpace: aGCSpace + | searched | + searched := spaces copyWithout: aGCSpace. + ^self markedEvaluate: [self hasMarkedReferencesTo: aGCSpace in: searched] +! ! + +!Memory methodsFor: 'statistics' stamp: 'KenD 28/Jun/2026 13:27:39'! +histogram + " + Memory current histogram + " + | sizes | + sizes := Dictionary new: 3000. + self critical: [| original | + original := spaces asOrderedCollection collect: #copy. + original do: [:space | space histogramInto: sizes]]. + ^sizes associations asArray sortBy: [:a :b | a value > b value] +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inGC + ^inGC +! ! + +!Memory methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + " + initialization of the spaces array is done manually because + this code is executed during bootstrap. + youngLimit is set to a high watermark so that all objects are + initially considered young. Until the young spaces are created + and this variable is reset, no object will be added to the + remembered set (specially closures, which are added just in + case when not young) + " + | empty | + super initialize. + inGC := false. + empty := Array new: 1000. + spaces := CriticalArray new usePinnedAllocation; contents: empty. + spaces allocator memory: self. + collectedSpaces := OrderedCollection new. + youngBase := 0. + youngLimit := 0xFFFFFFFFFFFFFFF. + meter := MemoryMeter new memory: self +! ! + +!Memory methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeCollectors + | movable | + movable := EdenCollector on: self. + genCollector := self kernelSpace shallowCopy: movable. + self rememberIfNeeded: genCollector. + movable := GarbageFirstCollector on: self. + fullCollector := self kernelSpace shallowCopy: movable. + self rememberIfNeeded: fullCollector +! ! + +!Memory methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isYoung: anObject + ^false == anObject _isSmallInteger + and: [anObject _asPointer between: youngBase and: youngLimit] +! ! + +!Memory methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isYoungSafe: anObject + ^anObject _asPointer between: youngBase and: youngLimit +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +kernelSpace + ^spaces first +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +largeSpaces + ^largeSpaces +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +make: anObject become: anotherObject + " + We cannot create closures here: the become action might be + applied to the closure elements before finishing and afterwards + we wouldn't find anObject anymore + " + | prev | + prev := CRITICAL. + CRITICAL := true. + 1 to: spaces size do: [:i | | space | + space := spaces at: i. + space make: anObject become: anotherObject]. + self rememberAfterBecome: anObject. + Processor activeProcess make: anObject become: anotherObject. + CRITICAL := prev +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +markedEvaluate: aClosure + " + We can leave not-young objects marked, but young ones + must be left unmarked. This is because young space scavenges + assume non-marked youngs to distinguish traced vs untraced + objects. + " + | marked result prev | + marked := spaces asOrderedCollection. + marked remove: edenSpace; remove: fromSpace. + prev := CRITICAL. + CRITICAL := inGC := true. + [ + marked do: [:space | space unmarkAll]. + fullCollector collect. + result := aClosure evaluate. + edenSpace unmarkAll. + fromSpace unmarkAll] evaluateAtomically. + inGC := false. + CRITICAL := prev. + self rescueEphemerons. + ^result +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +meterRuns + ^meter runs +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +newLargeArray: size + | headerSize bodySize totalSize buffer object | + #atomic. + headerSize := 16. + bodySize := size * WordSize. + totalSize := headerSize + bodySize. + buffer := self allocateLarge: totalSize. + object := (buffer + headerSize _asPointer) _asObject. + object + _longSlotAt: _Behavior put: Array instanceBehavior; + initializeExtended: true contentSize: size. + ^object _beArrayed; _nilSlots: size; yourself +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +newSpace + | space | + space := self pinnedCopy: GCSpace new. + ^space _beSeen +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +newSpaceAt: base limit: limit + ^self newSpace + base: base; + reservedLimit: limit; + memory: self +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +newSpaceAt: base size: size + ^self newSpaceAt: base limit: base + (size // 2) +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectsReferencing: targetSpace + | marked result prev | + marked := spaces asOrderedCollection. + marked remove: edenSpace; remove: fromSpace. + prev := CRITICAL. + CRITICAL := true. + [| tracer | + marked do: [:space | space unmarkAll]. + tracer := SpaceReferencesTracer new. + result := tracer + space: targetSpace; + updateAndFollow: ActiveProcess; + result. + edenSpace unmarkAll. + fromSpace unmarkAll] evaluateAtomically. + CRITICAL := prev. + ^result +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectsSurviving: aBlock + | set finalizable | + set := WeakIdentitySet new: 1000. + finalizable := Smalltalk finalizer copy. + self collectYoung; collectYoung. + self ASSERT: CRITICAL == false. + CRITICAL := true. + aBlock value. + CRITICAL := false. + self collectYoung. + fromSpace objectsDo: [:o | set add: o]. + self collect; collect. + set + removeAll: finalizable ifAbsent: nil; + removeAllSuchThat: [:o | o class == GenGCPass]. + ^set +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +old + ^oldZone +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +oldBase + ^oldZone base +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +oldLimit + ^oldZone limit +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +oldRecyclableByteCount + | total | + total := 0. + self + markedEvaluate: [oldZone + unmarkedDo: [:object | total := total + object _sizeInBytes]]. + ^total +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +oldSizesHistogram + | histogram | + histogram := Dictionary new. + self critical: [ + oldZone + objectsDo: [:object | histogram + at: object _sizeInBytes + put: 1 + ifPresent: [:count | count + 1]]]. + ^histogram +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +oldSpace + ^oldZone +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +pinnedAllocate: anInteger + | pointer | + pointer := pinnedSpace allocateIfPossible: anInteger. + pointer _isSmallInteger ifFalse: [ + ^anInteger > LargeThreshold + ifTrue: [self allocateLarge: anInteger] + ifFalse: [ + pinnedSpace dispenseReservedSpace. + self createPinnedSpace; pinnedAllocate: anInteger]]. + ^pointer +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +pinnedCopy: anObject + | copy | + copy := pinnedSpace shallowCopy: anObject. + copy _isSmallInteger ifTrue: [ + pinnedSpace dispenseReservedSpace. + ^self createPinnedSpace; pinnedCopy: anObject]. + (self shouldBeInRememberedSet: anObject) ifTrue: [self remember: copy]. + ^copy +! ! + +!Memory methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pointsToYoungObjects: anObject + (self isYoung: anObject behavior) ifTrue: [^true]. + 1 to: anObject _pointersSize do: [:index | | ivar | + ivar := anObject _basicAt: index. + ivar _isSmallInteger ifFalse: [(self isYoung: ivar) ifTrue: [^true]]]. + ^false +! ! + +!Memory methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: stream + | reserved commited used | + reserved := spaces + inject: 0 + into: [:sum :space | sum + (space reservedSize * 2)]. + commited := spaces + inject: 0 + into: [:sum :space | sum + (space commitedSize * 2)]. + used := spaces inject: 0 into: [:sum :space | sum + (space used * 2)]. + stream + nextPutAll: '==============='; + cr; + nextPutAll: 'Bee Memory:'; + cr; + nextPutAll: used printString , ' used'; + cr; + nextPutAll: commited printString , ' commited'; + cr; + nextPutAll: reserved printString , ' reserved'; + cr; + nextPutAll: meter statistics; + cr; + cr; + nextPutAll: 'spaces -> '; + cr; + nextPutAll: 'old: ' , oldZone printString; + cr; + nextPutAll: 'eden: ' , edenSpace printString; + cr; + nextPutAll: 'from: ' , fromSpace printString. + ^stream +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +queueEphemerons: aCriticalArray + unreachableEphemerons addAll: aCriticalArray +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +recyclableSimpleHistogram + | histogram | + histogram := Dictionary new. + self markedEvaluate: [ + oldZone + unmarkedDo: [:object | histogram + at: object _sizeInBytes + put: 1 + ifPresent: [:count | count + 1]]]. + ^histogram +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +referencesTo: anObject + " + The closure used for markedEvaluate: captures anObject, thus it + will be added to the reference list. We remove it from the result. + " + | references closure | + references := OrderedCollection new. + closure := [self addMarkedReferencesTo: anObject into: references]. + self markedEvaluate: closure. + references remove: closure. + ^references +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +remember: anObject + anObject _beRemembered. + rememberedSet add: anObject +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberedSet + ^rememberedSet +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberedSet: aRememberedSet + rememberedSet := aRememberedSet +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberIfNeeded: anObject + (self shouldBeInRememberedSet: anObject) ifTrue: [self remember: anObject] +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +rememberIfNotYoung: anObject + (self isYoung: anObject) ifFalse: [self remember: anObject] +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSpace: aCodeImageSegment + " + The spaces array could grow while executing. This could happen if a send site + cache is fetched and indirectly causes a large space or pinned space to be created. + To avoid that from happening we ensure there is a good amount of them free + " + self critical: [ + SendSite ensureEnoughFreeCaches: 100. + spaces remove: aCodeImageSegment space] +! ! + +!Memory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +rescueEphemerons + " + Rescuing ephemerons can trigger all kinds of behavior (i.e. process switches, + full GCs, etc). For that reason, in critical moments or when interrupts are disabled + we don't rescue them instantly. They won't be lost, but will be rescued after the + next GC. + Each time an ephemeron being rescued causes GC, that GC pass will recusively + send rescueEphemerons. If not careful, that recursion can chain and quickly consume + all the stack space. For that reason, we remove all currently unreachable from the + list, so that recursive GCs end up sooner (once an ephemeron is found unreachable + it is deactivated, so it won't be added again to the unreachable list) + " + | work | + CRITICAL ifTrue: [^self]. + Processor areInterruptsEnabled ifFalse: [^self]. + work := unreachableEphemerons. + work isEmpty ifTrue: [^self]. + unreachableEphemerons := CriticalArray new growTo: 1000. + work do: [:e | [e rescue] ifCurtailed: [e activate]] +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +reserveSpaceSized: reserved commiting: commited + | space address | + address := Kernel os reserve: reserved. + space := self newSpace address: address size: reserved. + ^space commit: commited +! ! + +!Memory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +reserveZoneSized: size near: start + | address | + address := Kernel os reserve: size near: start. + ^AllocationZone new + memory: self; + base: address // 2; + limit: address + size // 2; + build +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +roots + ^{Processor activeProcess} +! ! + +!Memory methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:39'! +shallowCopy: object + | headerSize answer size allocation objectPointer | + size := object _bodySizeInBytes. + headerSize := object _headerSizeInBytes. + allocation := self allocate: headerSize + size. + objectPointer := allocation + headerSize _asPointer. + answer := objectPointer _asObject. + answer _copyHeaderSized: headerSize from: object. + answer _replaceFrom: 1 to: (size bitShift: 0 - WordSizeShift) with: object. + answer _beNotRemembered. + ^answer +! ! + +!Memory methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldBeInRememberedSet: anObject + (self isYoung: anObject) ifTrue: [^false]. + ^self pointsToYoungObjects: anObject +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +spaces + ^spaces +! ! + +!Memory methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +startUp + fromSpace == self kernelSpace + ifTrue: [self createRememberedSet; createSpaces; createPinnedSpace]. + self initializeCollectors +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +to + ^toSpace +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +unreachableEphemerons + ^unreachableEphemerons +! ! + +!Memory methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +usedSpace + " + Memory current usedSpace + " + ^spaces inject: 0 into: [:sum :space | sum + (space used * 2)] +! ! + +!Memory methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +verifyMemory + | stacks | + self debugMode ifFalse: [^self]. + stacks := LinkedCollection new: 100. + self markedEvaluate: [ + spaces do: [:space | + space markedDo: [:object | | index slots | + (toSpace includes: object behavior) ifTrue: [self _halt]. + index := 1. + slots := object _strongPointersSize. + [index <= slots] whileTrue: [| reference | + reference := object _basicAt: index. + (toSpace includes: reference) ifTrue: [self _halt]. + index := index + 1]. + object class == ProcessLMRStack ifTrue: [stacks add: object]]]]. + ^stacks +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +youngBase + ^youngBase +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +youngLimit + ^youngLimit +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Memory class' category: #Kernel! +Memory class + instanceVariableNames: 'Current LargeThreshold CRITICAL'! + +!Memory class methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocateMemory: size near: address + | limit | + limit := (1 bitShift: WordSize * 8 - 2) - size. + ^self allocateMemory: size near: address limit: limit +! ! + +!Memory class methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocateMemory: size near: address limit: limit + ^Smalltalk os allocate: size near: address limit: limit. +! ! + +!Memory class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +current + ^Current +! ! + +!Memory class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +current: current + Current := current +! ! + +!Memory class methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:39'! +nativeAllocate: size + Smalltalk os nativeAllocate: size + +! ! + +!Memory class methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:39'! +shallowCopy: anObject + ^Current shallowCopy: anObject +! ! + + +Memory initialize! + diff --git a/modules/LMR/MemoryMeter.Class.st b/modules/LMR/MemoryMeter.Class.st new file mode 100644 index 00000000..2d9da418 --- /dev/null +++ b/modules/LMR/MemoryMeter.Class.st @@ -0,0 +1,107 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #MemoryMeter category: #Kernel! +Object subclass: #MemoryMeter + instanceVariableNames: 'memory runs time maxPause youngFreed oldGrown grows shrinks rescued' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!MemoryMeter commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!MemoryMeter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +growIfTime + memory old percentageOfCommitedUsed > 90 ifTrue: [ + grows := grows + 1. + memory commitMoreSpace] +! ! + +!MemoryMeter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + runs := 0. + time := 0. + maxPause := 0. + youngFreed := 0. + oldGrown := 0. + grows := 0. + shrinks := 0. + rescued := 0 +! ! + +!MemoryMeter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +measure: aBlock + | eden from old milliseconds | + eden := memory eden usedBytes. + from := memory from usedBytes. + old := memory old usedBytes. + milliseconds := (Smalltalk os microsecondsToRun: aBlock) / 1000.0. + oldGrown := memory old usedBytes - old. + youngFreed := memory from usedBytes - from - eden. + runs := runs + 1. + time := time + milliseconds. + maxPause := milliseconds max: maxPause. + rescued := memory rescuedEphemerons size +! ! + +!MemoryMeter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +memory: aMemory + memory := aMemory +! ! + +!MemoryMeter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +statistics + ^String streamContents: [:s | + s + print: runs; + nextPutAll: ' runs took '; + nextPutAll: time printString; + nextPutAll: 'ms (max pause was '; + print: maxPause; + nextPutAll: 'ms, estimated throughput: ~'; + nextPutAll: (self throughput printFraction: 3); + nextPutAll: 'mb/s). Rescued '; + print: rescued; + nextPutAll: ' ephemerons. Grown '; + print: grows; + nextPutAll: ' times.'] +! ! + +!MemoryMeter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +statitistics + ^String streamContents: [:s | + s + print: runs; + nextPutAll: ' runs took '; + nextPutAll: time printString; + nextPutAll: 'ms (max pause was '; + print: maxPause; + nextPutAll: 'ms, estimated throughput: ~'; + nextPutAll: (self throughput printFraction: 3); + nextPutAll: 'mb/s). Rescued '; + print: rescued; + nextPutAll: ' ephemerons. Grown '; + print: grows; + nextPutAll: ' times.'] +! ! + +!MemoryMeter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +throughput + ^time = 0 + ifTrue: [0] + ifFalse: [memory eden commitedSize + memory from commitedSize * 2 * runs + * 1000 + / (time * 1024 * 1024)] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MemoryMeter class' category: #Kernel! +MemoryMeter class + instanceVariableNames: ''! + + +MemoryMeter initialize! + diff --git a/modules/LMR/NativeCode.Class.st b/modules/LMR/NativeCode.Class.st new file mode 100644 index 00000000..7defaf0b --- /dev/null +++ b/modules/LMR/NativeCode.Class.st @@ -0,0 +1,106 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #NativeCode category: #Kernel! +Object subclass: #NativeCode + instanceVariableNames: 'machineCode compiledCode' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!NativeCode commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +block + ^compiledCode +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +block: aCompiledBlock + compiledCode := aCompiledBlock +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +bytes + ^machineCode +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +code + ^machineCode +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +code: bytes + machineCode := bytes +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +compiledCode + ^compiledCode +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +compiledCode: anObject + compiledCode := anObject +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +disassembledText32 + ^machineCode disassembledText32 +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +disassembledText64 + ^machineCode disassembledText64 +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +entryPoint + ^machineCode oop +! ! + +!NativeCode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isNativeCode + ^true +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +method + ^compiledCode +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +method: aCompiledMethod + compiledCode := aCompiledMethod +! ! + +!NativeCode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +nativeCodeAddress + ^machineCode _oop +! ! + +!NativeCode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +newEnvironment: anInteger + ^Array new: anInteger +! ! + +!NativeCode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +sendSites + ^self select: [:obj | obj class == SendSite] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NativeCode class' category: #Kernel! +NativeCode class + instanceVariableNames: ''! + +!NativeCode class methodsFor: 'inspecting' stamp: 'KenD 28/Jun/2026 13:27:39'! +aspects + ^#(#disassembledText32 #disassembledText64) +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/ABI.Class.st b/modules/LMR/Nativizer/Assembly/ABI.Class.st new file mode 100644 index 00000000..39040000 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/ABI.Class.st @@ -0,0 +1,120 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ABI category: #'Nativization-Assembly'! +Object subclass: #ABI + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization-Assembly'! +!ABI commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. + +`ABI` seems to serve two different purposes: + + i) provide support for calling (native) function with system + calling convention for given architecture and OS combination + +ii) provide fixed mapping from 'IR' registers (such as A, R, M and so on) + to real machine registers + +! + +!ABI methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +is32bits + ^self bits = 32 +! ! + +!ABI methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +is64bits + ^self bits = 64 +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regA + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regE + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFP + ^ self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFalse + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regG + ^ self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regIP + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regM + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regNil + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regR + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regS + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regSP + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regT + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regTrue + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regV + ^self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regX0 + ^ self subclassResponsibility +! ! + +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regX1 + ^ self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ABI class' category: #'Nativization-Assembly'! +ABI class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Assembler.Class.st b/modules/LMR/Nativizer/Assembly/Assembler.Class.st new file mode 100644 index 00000000..561a06ce --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Assembler.Class.st @@ -0,0 +1,1774 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #Assembler category: #'Powerlang-Core-Assembly'! +Object subclass: #Assembler + instanceVariableNames: 'labels literals' + classVariableNames: 'IndexedLabels' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!Assembler commentStamp: '' prior: 0! + +I am the JIT assembler frontend. I provide a high-level assembler interface (if that really exists) +and delegate writing of the actual bytes to my backends. +! + +!Assembler methodsFor: 'labels' stamp: 'KenD 28/Jun/2026 13:27:40'! +@ label + self addLabel: label +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +add: source1 to: source2andDest + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addAtoR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addDoubleX1toX0 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addImm: imm to: dest + self subclassResponsibility +! ! + +!Assembler methodsFor: 'labels' stamp: 'KenD 28/Jun/2026 13:27:40'! +addLabel: aString + self addLabel: aString to: self currentAddress +! ! + +!Assembler methodsFor: 'labels' stamp: 'KenD 28/Jun/2026 13:27:40'! +addLabel: label to: location + labels at: label put: location +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +addLiteral: anObject + | index | + index := literals + identityIndexOf: anObject + ifAbsent: [ literals + add: anObject; + size ]. + ^ index + 2 +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addRwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addSPwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addTtoR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addTwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +alignTo: anInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +and: source1andDest with: source2 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +and: source1andDest withImm: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +andRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +andRwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +breakpoint + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildFrame + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +bytes + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +callIndirectA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +callIndirectM + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +callR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearFPUFlags + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearIntegerBit: srcAndDstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearRhigh32 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearRintegerBit + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearSafeIntegerBit: srcAndDstReg + self and: srcAndDstReg withImm: -2 +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearSafeRintegerBit + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: reg1 with: reg2 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: register withBoolean: aBoolean + aBoolean + ifTrue: [ self compareWithTrue: register ] + ifFalse: [ self compareWithFalse: register ] +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: register withLiteral: anObject + self subclassResponsibility +! ! + +!Assembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareAwithBoolean: aBoolean + aBoolean + ifTrue: [ self compareAwithTrue ] + ifFalse: [ self compareAwithFalse ] +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareAwithFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareAwithTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareEqualDoubleX0withAindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareLessThanDoubleX0withAindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithBoolean: aBoolean + aBoolean + ifTrue: [ self compareRwithTrue ] + ifFalse: [ self compareRwithFalse ] +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithSmallInteger: anInteger + | smi | + smi := self smallInteger: anInteger. + self compareRwithImmediate: smi +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareSwithTindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareTwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareTwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareWithFalse: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareWithNil: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareWithTrue: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertAtoNativeInteger + self subclassResponsibility + +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertRtoNativeInteger + self subclassResponsibility + +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertRtoSmallInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertToNativeInteger: srcAndDstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertToSmallInteger: srcAndDstReg + self shiftLeft: srcAndDstReg byImm: 1; inc: srcAndDstReg +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertTtoNativeInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +currentAddress + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +dec: srcAndDstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +decRindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +discardArguments: anInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +divideDoubleX0byX1 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +dropTopOfFPU + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +dropTos: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +exchangeRindirectWithT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +extendRtoAandDividebyT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +inc: srcAndDstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfEqualTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfGreaterOrEqualSignedTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfGreaterSignedTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfLessOrEqualSignedTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfLessSignedTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfNotEqualTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfNotZeroTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfOverflowTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfSignTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfZeroTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpOver: aBlock + | label | + label := self newLabel. + self jumpTo: label. + aBlock value. + self @ label +! ! + +!Assembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpToMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerBitTestOf: aRegister + | label | + self testIntegerBitOf: aRegister. + label := self newLabel. + self shortJumpIfZeroTo: label. + ^label +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerBitTestOfR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerBitTestOfT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerNativizationOf: aRegister + | label | + self convertToNativeInteger: aRegister. + label := self newLabel. + self shortJumpIfNotCarryTo: label. + ^label +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerNativizationOfA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerNativizationOfR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerNativizationOfT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledNonIntegerBitTestOf: aRegister + | label | + self testIntegerBitOf: aRegister. + label := self newLabel. + self shortJumpIfNotZeroTo: label. + ^label +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledNonIntegerBitTestOfR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +leadingRzeroCount + self subclassResponsibility +! ! + +!Assembler methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: dstReg fromMem: srcMemRef + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +load:dstReg withImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: register withLiteral: anObject + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithAindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithEindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithGindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithGlobal: aSymbol + | index | + index := NativizationEnvironment indexOfGlobal: aSymbol. + self loadAwithGindex: index +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithKnown: anObject + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadAwithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithRoffsetAtA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithSindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithSmallInteger: anInteger + | smi | + smi := (anInteger bitShift: 1) + 1. + self loadAwithImmediate: smi +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithAddressOfRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadFPwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadFPwithSP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadFalseWithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadFalseWithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadFalseWithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadGwithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadGwithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadGwithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLargeX0withRindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLargeX1withAindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLongMwithIPoffset: anInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLongRwithRatOffsetA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLongSwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMXCSRfromA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithGindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithGlobal: aSymbol + | index | + index := NativizationEnvironment indexOfGlobal: aSymbol. + self loadMwithGindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithTindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadNilWithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadNilWithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadNilWithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRconvertingDoublePointedByR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithArgPointer + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithE + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithEindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadRwithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithM + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithRatOffsetA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithSPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithSindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithSmallInteger: anInteger + | smi | + smi := self smallInteger: anInteger. + self loadRwithImmediate: smi +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithTIBatR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithThreadVariableAtR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSPwithFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithAddressOfSatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithGindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTrueWithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadTrueWithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTrueWithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithAindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithEindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadTwithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithTindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadWithFalse: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadWithNil: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadWithTrue: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadX0withRasDouble + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByte: dstReg from: srcBaseReg atIndexAt: srcIndexReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByte: dstReg from: srcBaseReg atIndexImm: indexImm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByte: reg1 from: reg2 atOffset: offset + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByteRwithRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByteRwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByteRwithSPatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByteTwithAindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendLongRwithRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendLongRwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendShortRwithRoffset: offset + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +lock + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +loop: aBlock times: anInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +loopTtimes: aBlock + self subclassResponsibility +! ! + +!Assembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +move: srcReg to: dstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveImm: imm to: dstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveTslots + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveX0toR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +multiplyDoubleX0byX1 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +multiplyRbyAwideningToA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativeCode + self subclassResponsibility +! ! + +!Assembler methodsFor: 'labels' stamp: 'KenD 28/Jun/2026 13:27:40'! +newLabel + | label next | + next := labels size + 1. + IndexedLabels size < next ifTrue: [self class growIndexedLabelsTo: next]. + label := IndexedLabels at: next. + self addLabel: label to: nil. + ^label +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +or: src1AndDst with: src2 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +or: source1andDest withImm: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +orRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +platform: aNativizationPlatform +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +pop: dstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popE + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popG + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popM + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +popSPindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +push: srcReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushAatToffset: offset + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushE + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushG + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushImm: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushIndirectR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushM + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushSmallInteger: integer + | smi | + smi := self smallInteger: integer. + self pushImm: smi +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +readFPUStatusOnA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regA8 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regE + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regG + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regIP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regM + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regR8 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regSP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regT8 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regV + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regX0 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regX1 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +renameByteRegisterIfNeeded: register preserving: preserved during: aBlock + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +renameByteRegisterIfNeeded: register preserving: preserved1 preserving: preserved2 during: aBlock + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +reserveStackSlots: amount + self subclassResponsibility +! ! + +!Assembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +reset + labels := Dictionary new: 100. + literals := OrderedCollection new. +! ! + +!Assembler methodsFor: 'labels' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolveLabel: aString + ^labels at: aString +! ! + +!Assembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreCallerEnvironment + self loadEwithFPindex: -2 +! ! + +!Assembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreCallerFrame + self subclassResponsibility +! ! + +!Assembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreCallerM + self loadMwithFPindex: -1 +! ! + +!Assembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreCallerSelf + self loadSwithFPindex: 0 +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +return + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +roundDoubleX0intoX1 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +saveCallerFrame + self pushFP; loadFPwithSP +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +scaleFloatOnRWithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +setIntegerBit: srcAndDstReg + self setSafeIntegerBit: srcAndDstReg +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +setRintegerBit + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +setSafeIntegerBit: srcAndDstReg + self or: srcAndDstReg withImm: 1 +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +setSafeRintegerBit + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLeft: srcAndDst by: countReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLeft: srcAndDst byImm: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLeftRwithT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLogicalRright: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRight: srcAndDst by: countReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRight: srcAndDst byImm: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightArithmetic: srcAndDst by: countReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightArithmetic: srcAndDst byImm: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightRwithT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRleft: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRright: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftTright: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfCarryTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfEqualTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfNotCarryTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfNotEqualTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfNotZeroTo: label + self shortJumpIfNotEqualTo: label +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfSignTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfZeroTo: label + self shortJumpIfEqualTo: label +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +smallInteger: anInteger + ^(anInteger bitShift: 1) + 1 +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +sqrtDoubleX0 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeAinThreadVariableAtIndexR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeAinTindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeByteAinRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeByteTinRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeDoubleResultInRindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeEinRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLargeX0inA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLargeX0inT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLongTinRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLongTinRatOffsetA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeMXCSRintoA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinAindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinEindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinSindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinTindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeShortAinRoffset: offset + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeShortTinRatOffsetA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeSinRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTIBatRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTinRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTinRatOffsetA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTinRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +sub: src2 from: src1AndDst + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subAfromR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subAfromT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +subDoubleX1fromX0 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subFromRconstant: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subImm: imm from: srcAndDst + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +subTslotsToSP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +platform: aNativizationPlatform + self reset +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +testIntegerBit: aRegister + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +testIntegerBitOf: aRegister + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +testRintegerBit + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +testRwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSize + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeTslots + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +xor: src1AndDst with: src2 + ^ self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +xorAwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +xorFPwithFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +xorRwithA + self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Assembler class' category: #'Powerlang-Core-Assembly'! +Assembler class + instanceVariableNames: 'IndexedLabels'! + +!Assembler class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +growIndexedLabelsTo: anInteger + | new | + new := (IndexedLabels size + 1 to: anInteger) + collect: [:i | ('@' , i asString) asSymbol]. + IndexedLabels := IndexedLabels , new +! ! + +!Assembler class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + self initializeIndexedLabels + +! ! + +!Assembler class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeIndexedLabels + IndexedLabels := #(). + self growIndexedLabelsTo: 100 +! ! + + +Assembler initialize! + diff --git a/modules/LMR/Nativizer/Assembly/CodeGenerator.Class.st b/modules/LMR/Nativizer/Assembly/CodeGenerator.Class.st new file mode 100644 index 00000000..0deb1dfe --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/CodeGenerator.Class.st @@ -0,0 +1,659 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #CodeGenerator category: #'Powerlang-Core-Assembly'! +Object subclass: #CodeGenerator + instanceVariableNames: 'abi wordSize memory' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +add: source1 to: source2andDest + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addDouble: source1 to: source2andDest + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addImm: imm to: dest + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addressBitSize + ^self addressSize * 8 + +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addressLength + ^wordSize * 8 +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addressSize + "Return the size of address in bytes, e.g, 4 for 32bit archs + and 8 for 64bit archs" + + ^wordSize +! ! + +!CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +alignTo: aNumber + | current count | + current := memory position. + count := (current alignedTo: aNumber) - current. + self nop: count +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +and: source1andDest with: source2 + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +and: source1andDest withImm: imm + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'relocation' stamp: 'KenD 28/Jun/2026 13:27:40'! +baseAddress + ^memory baseAddress +! ! + +!CodeGenerator methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +bitLengthOf: anInteger + (anInteger between: -16r80 and: 16r7F) ifTrue: [^8]. + (anInteger between: -16r8000 and: 16r7FFF) ifTrue: [^16]. + (anInteger between: -16r80000000 and: 16r7FFFFFFF) ifTrue: [^32]. + (anInteger between: -16r8000000000000000 and: 16r7FFFFFFFFFFFFFFF) + ifTrue: [^64]. + (anInteger + between: -16r80000000000000000000000000000000 + and: 16r7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF) + ifTrue: [^128]. + ^nil +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +breakpoint + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +bytes + ^memory bytes +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +call: srcReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +callIndirect: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearHigh32: srcAndDstReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +codeSize + ^memory codeSize +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: reg1 with: reg2 + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: reg1 withImm: imm + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: reg1 withMem: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convert: src toDouble: dst + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'labels' stamp: 'KenD 28/Jun/2026 13:27:40'! +currentAddress + ^memory currentAddress +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +dec: srcAndDstReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +decMem: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +divDouble: src1andDstReg by: src2reg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +divide: srcAndDstReg extendingTo: extReg by: divisorReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +exchange: srcAndDstReg withMem: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +inc: srcAndDstReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + memory := RelocatableBuffer new. +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpTo: label + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpToMem: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +lea: dstReg withMem: srcMemRef + ^self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: dstReg convertingDoubleToIntegerFromMem: srcMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: dstReg fromMem: srcMemRef + "Load `dstReg` from memory location `srcMemRef`. + The size of data loaded is specified in `srcMemRef`. + + When loading 32bits into 64bit register, high 32bits must be + cleared (in other words, 32bit value is *zero* extended to + 64bits and stored in `dstReg`. + + However, when loading 16bits or 8bits, high 48 or 56 bits + are *left intact*. + + This somewhat weird behavior is heritage of x86. + " + + ^ self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: dstReg withTIBat: indexReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: dstReg withThreadVariableAt: indexReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadDouble: dstReg fromMem: srcMemRef + "Load 64-bit floating point `dstReg` from memory location `srcMemRef`" + + ^ self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef16 + "Return clean instance of memory reference." + + ^ self memRef length: 16; yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef16: baseReg offset: offsetReg + ^ self memRef16 + base: baseReg; + index: offsetReg; + scale: 1; + yourself +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef16: baseReg offsetImm: offsetImm + ^ self memRef16 + base: baseReg; + displacement: offsetImm; + yourself +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef32 + "Return clean instance of memory reference." + + ^ self memRef length: 32; yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef32: baseReg index: indexReg + ^ self memRef32 + base: baseReg; + displacement: -4; + index: indexReg; + scale: 4; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef32: baseReg indexImm: indexImm + ^ self memRef32 + base: baseReg; + displacement: (indexImm - 1) * 4; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef32: baseReg offset: offsetReg + ^ self memRef32 + base: baseReg; + index: offsetReg; + scale: 1; + yourself +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef64 + "Return clean instance of memory reference." + + ^ self memRef length: 64; yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef64: baseReg indexImm: indexImm + ^ self memRef64 + base: baseReg; + displacement: (indexImm - 1) * 8; + yourself +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef8 + "Return clean instance of memory reference." + + ^ self memRef length: 8; yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef8: baseReg index: indexReg + ^ self memRef8 + base: baseReg; + displacement: -1; + index: indexReg; + scale: 1; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef8: baseReg indexImm: indexImm + ^ self memRef8 + base: baseReg; + displacement: (indexImm - 1); + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef: baseReg index: indexRef + ^ self memRef + base: baseReg; + displacement: self addressSize negated; + index: indexRef; + scale: self addressSize; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef: baseReg index: indexRef offsetImm: anInteger + ^ self memRef + base: baseReg; + displacement: anInteger; + index: indexRef; + scale: self addressSize; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef: baseReg indexImm: indexImm + ^ self memRef + base: baseReg; + displacement: (indexImm - 1) * self addressSize; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef: baseReg offset: indexReg + ^ self memRef + base: baseReg; + index: indexReg; + scale: 1; + yourself +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRefAatT +^self memRef: self regA index: self regT +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRefSPatT + ^ self memRef: self regSP index: self regT +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +memory + ^memory +! ! + +!CodeGenerator methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +move: srcReg to: dstReg + ^ self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveDouble: srcReg into: dstReg + "move from X-type register srcReg into general purpose dstReg" + + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveImm: imm to: dstReg + "Load constant to register `dstImm`" + + self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +mulDouble: src1andDstReg by: src2reg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +multiply: src1AndDstLoReg by: src2reg wideningTo: dstHiReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativeCode + ^ NativeCode new code: memory bytes +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +or: src1andDest withImm: imm + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pop: dstReg + ^ self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popIntoMem: dstMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +push: srcReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushAOnFPUStack + ^ self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushImm: imm + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushMem: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushROnFPUStack + ^ self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regA + ^abi regA +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regE + ^abi regE +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFP + ^abi regFP +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFalse + ^abi regFalse +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regG + ^ abi regG +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regIP + ^abi regIP +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regM + ^abi regM +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regNil + ^abi regNil +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regR + ^abi regR +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regS + ^abi regS +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regSP + ^abi regSP +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regT + ^abi regT +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regTrue + ^abi regTrue +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regV + ^abi regV +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regX0 + ^ abi regX0 +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regX1 + ^ abi regX1 +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +reset + memory reset +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +roundDouble: srcReg into: dstReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLeft: srcAndDst byImm: count + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRight: srcAndDst byImm: count + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightArithmetic: srcAndDst by: countReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightArithmetic: srcAndDst byImm: count + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +sqrtDouble: srcReg into: dstReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +store: srcReg intoMem: dstMemRef + "Store `srcReg` into memory location `dstMemRef`. + + The size of data loaded is specified in `dstMemRef`" + ^self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeDouble: srcReg intoMem: dstMemRef + ^ self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +stream + ^memory stream +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +sub: src1 from: src2AndDst + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subDouble: src1 from: src2AndDst + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subImm: imm from: srcAndDst + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +platform: aNativizationPlatform + abi := aNativizationPlatform abi. + wordSize := aNativizationPlatform wordSize. +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +test: src1Reg with: src2Reg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +test: srcReg withImm: imm + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSize + ^wordSize +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSize: anInteger + self ASSERT: anInteger == 8. + wordSize := anInteger. +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSizeShift + ^wordSize = 8 ifTrue: [3] ifFalse: [2] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CodeGenerator class' category: #'Powerlang-Core-Assembly'! +CodeGenerator class + instanceVariableNames: ''! + + +CodeGenerator initialize! + diff --git a/modules/LMR/Nativizer/Assembly/GenericAssembler.Class.st b/modules/LMR/Nativizer/Assembly/GenericAssembler.Class.st new file mode 100644 index 00000000..9b8696d4 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/GenericAssembler.Class.st @@ -0,0 +1,1859 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #GenericAssembler category: #'Powerlang-Core-Assembly'! +Assembler subclass: #GenericAssembler + instanceVariableNames: 'codegen' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!GenericAssembler commentStamp: '' prior: 0! + +I am a JIT GenericAssembler frontend that can generate code for different architectures +using different code generators. +! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +add: source1 to: source2andDest + codegen add: source1 to: source2andDest +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addAtoR + codegen add: codegen regA to: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addDoubleX1toX0 + codegen addDouble: codegen regX1 to: codegen regX0 + +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addImm: imm to: dest + codegen addImm: imm to: dest +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addRwithImmediate: imm + codegen addImm: imm to: codegen regR +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addSPwithImmediate: imm + codegen addImm: imm to: codegen regSP +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addTtoR + codegen add: codegen regT to: codegen regR +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addTwithImmediate: imm + codegen addImm: imm to: codegen regT +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +alignTo: anInteger + codegen alignTo: anInteger +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +and: source1andDest with: source2 + codegen and: source1andDest with: source2 +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +and: source1andDest withImm: imm + codegen and: source1andDest withImm: imm +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +andRwithA + codegen and: codegen regR with: codegen regA +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +andRwithImmediate: imm + codegen and: codegen regR withImm: imm +! ! + +!GenericAssembler methodsFor: 'relocation' stamp: 'KenD 28/Jun/2026 13:27:40'! +applyFixups + codegen memory applyFixupsWith: self +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +breakpoint + codegen breakpoint +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildFrame + self + push: codegen regFP; + move: codegen regSP to: codegen regFP +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +bytes + ^codegen bytes +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +callIndirectA + | memref | + memref := codegen memRef: codegen regA indexImm: 1. + codegen callIndirect: memref +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +callIndirectM + | memref | + memref := codegen memRef: codegen regM indexImm: 1. + codegen callIndirect: memref +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +callR + codegen call: codegen regR +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearFPUFlags + codegen clearFPUFlags +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearRhigh32 + codegen clearHigh32: codegen regR + +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearRintegerBit + self dec: codegen regR +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearSafeRintegerBit + self clearSafeIntegerBit: codegen regR +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: reg1 with: reg2 + codegen compare: reg1 with: reg2 +! ! + +!GenericAssembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: register withBoolean: aBoolean + aBoolean + ifTrue: [ self compareWithTrue: register ] + ifFalse: [ self compareWithFalse: register ] +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: register withLiteral: anObject + | index memref | + index := self addLiteral: anObject. + memref := codegen memRef: codegen regM indexImm: index. + codegen compare: register withMem: memref +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareAwithFalse + codegen compare: codegen regA with: codegen regFalse +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareAwithTrue + codegen compare: codegen regA with: codegen regTrue +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareEqualDoubleX0withAindirect + codegen compareEqualDoubleX0withAindirect +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareLessThanDoubleX0withAindirect + codegen compareLessThanDoubleX0withAindirect +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithA + codegen compare: codegen regR with: codegen regA +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithFalse + codegen compare: codegen regR with: codegen regFalse +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithImmediate: imm + codegen compare: codegen regR withImm: imm +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithNil + codegen compare: codegen regR with: codegen regNil +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithTrue + codegen compare: codegen regR with: codegen regTrue +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareSwithTindex: index + | memref | + memref := codegen memRef: codegen regT indexImm: index. + codegen compare: codegen regS withMem: memref +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareTwithA + codegen compare: codegen regT with: codegen regA +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareTwithImmediate: imm + codegen compare: codegen regT withImm: imm +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareWithFalse: register + codegen compare: register with: codegen regFalse +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareWithNil: register + codegen compare: register with: codegen regNil +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareWithTrue: register + codegen compare: register with: codegen regTrue +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertAtoNativeInteger + self convertToNativeInteger: codegen regA + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertRtoNativeInteger + self convertToNativeInteger: codegen regR + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertRtoSmallInteger + self convertToSmallInteger: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertToNativeInteger: srcAndDstReg + codegen shiftRightArithmetic: srcAndDstReg byImm: 1 +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertTtoNativeInteger + self convertToNativeInteger: codegen regT +! ! + +!GenericAssembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +currentAddress + ^ codegen currentAddress +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +dec: srcAndDstReg + codegen dec: srcAndDstReg +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +decRindirect + | memref | + memref := codegen memRef: codegen regR indexImm: 1. + codegen decMem: memref +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +discardArguments: anInteger + anInteger = 0 ifTrue: [^self]. + codegen addImm: anInteger * codegen wordSize to: codegen regSP +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +divideDoubleX0byX1 + codegen divDouble: codegen regX0 by: codegen regX1 +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +dropTopOfFPU + codegen dropTopOfFPU +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +dropTos: count + codegen addImm: (count * codegen addressSize) to: codegen regSP +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +exchangeRindirectWithT + | memref | + memref := codegen memRef: codegen regR indexImm: 1. + codegen exchange: codegen regT withMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +extendRtoAandDividebyT + codegen divide: codegen regR extendingTo: codegen regA by: codegen regT +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +inc: srcAndDstReg + codegen inc: srcAndDstReg +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeS + codegen move: codegen regR to: codegen regS +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfEqualTo: label + codegen jumpIfEqualTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfGreaterOrEqualSignedTo: label + codegen jumpIfGreaterOrEqualSignedTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfGreaterSignedTo: label + codegen jumpIfGreaterSignedTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfLessOrEqualSignedTo: label + codegen jumpIfLessOrEqualSignedTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfLessSignedTo: label + codegen jumpIfLessSignedTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfNotEqualTo: label + codegen jumpIfNotEqualTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfNotZeroTo: label + codegen jumpIfNotZeroTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfOverflowTo: label + codegen jumpIfOverflowTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfSignTo: label + codegen jumpIfSignTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfZeroTo: label + codegen jumpIfZeroTo: label +! ! + +!GenericAssembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpTo: label + codegen jumpTo: label +! ! + +!GenericAssembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpToMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen jumpToMem: memref +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerBitTestOfR + ^self labeledIntegerBitTestOf: codegen regR +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerBitTestOfT + ^self labeledIntegerBitTestOf: codegen regT byte +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerNativizationOfA + ^self labeledIntegerNativizationOf: codegen regA +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerNativizationOfR + ^self labeledIntegerNativizationOf: codegen regR +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledIntegerNativizationOfT + ^self labeledIntegerNativizationOf: codegen regT +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +labeledNonIntegerBitTestOfR + ^self labeledNonIntegerBitTestOf: codegen regR +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +leadingRzeroCount + codegen leadingRzeroCount +! ! + +!GenericAssembler methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: dstReg fromMem: srcMemRef + ^codegen load: dstReg fromMem: srcMemRef +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +load:dstReg withImmediate: imm + codegen moveImm: imm to: dstReg +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: register withLiteral: anObject + | index memref | + index := self addLiteral: anObject. + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: register + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithAindex: index + | memref | + memref := codegen memRef: codegen regA indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithEindex: index + | memref | + memref := codegen memRef: codegen regE indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithFalse + codegen move: codegen regFalse to: codegen regA +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithGindex: index + | memref | + memref := codegen memRef: codegen regG indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithGlobal: aSymbol + | index | + index := NativizationEnvironment indexOfGlobal: aSymbol. + self loadAwithGindex: index +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithImmediate: imm + self load: codegen regA withImmediate: imm +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithKnown: anObject + codegen breakpoint +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadAwithMindex: index +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithNil + codegen move: codegen regNil to: codegen regA +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithR + codegen move: codegen regR to: codegen regA +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithRoffsetAtA + | memref | + memref := codegen memRef + base: codegen regR; + index: codegen regA; + scale: 1. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithS + codegen move: codegen regS to: codegen regA +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithSindex: index + | memref | + memref := codegen memRef: codegen regS indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithSmallInteger: anInteger + | smi | + smi := (anInteger bitShift: 1) + 1. + self loadAwithImmediate: smi +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithTrue + codegen move: codegen regTrue to: codegen regA +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithAddressOfRatA + | memref | + memref := codegen + memRef: codegen regR + index: codegen regA + offsetImm: codegen wordSize negated. + codegen lea: codegen regE withMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regE + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithNil + codegen move: codegen regNil to: codegen regE +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithR + codegen move: codegen regR to: codegen regE +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadFPwithR + codegen move: codegen regR to: codegen regFP +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadFPwithSP + codegen move: codegen regSP to: codegen regFP +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadFalseWithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regFalse + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadGwithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regG + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLargeX0withRindirect + | memref | + memref := codegen memRef64: codegen regR indexImm: 1. + codegen loadDouble: codegen regX0 fromMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLargeX1withAindirect + | memref | + memref := codegen memRef64: codegen regA indexImm: 1. + codegen loadDouble: codegen regX1 fromMem: memref +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLongMwithIPoffset: anInteger + codegen loadLongMwithIPoffset: anInteger +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLongRwithRatOffsetA + | memref | + memref := codegen + memRef32: codegen regR + offset: codegen regA. + codegen load: codegen regR fromMem: memref + +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLongSwithRindex: index + | memref | + memref := codegen memRef32: codegen regR indexImm: index. + codegen load: codegen regS fromMem: memref + +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMXCSRfromA + codegen loadMXCSRfromA +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithA + codegen move: codegen regA to: codegen regM +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regM + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithGindex: index + | memref | + memref := codegen memRef: codegen regG indexImm: index. + codegen + load: codegen regM + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regM + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + load: codegen regM + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithTindex: index + | memref | + memref := codegen memRef: codegen regT indexImm: index. + codegen + load: codegen regM + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadNilWithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regNil + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRconvertingDoublePointedByR + | memref | + memref := codegen memRef64: codegen regR indexImm: 1. + codegen load: codegen regR convertingDoubleToIntegerFromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithA + codegen move: codegen regA to: codegen regR +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithArgPointer + | memref | + memref := codegen memRef: codegen regFP indexImm: 3. + codegen lea: codegen regR withMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithE + codegen move: codegen regE to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithEindex: index + | memref | + memref := codegen memRef: codegen regE indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithFP + codegen move: codegen regFP to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithFalse + codegen move: codegen regFalse to: codegen regR +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithImmediate: imm + self load: codegen regR withImmediate: imm +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithM + codegen move: codegen regM to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithNil + codegen move: codegen regNil to: codegen regR +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithRatA + | memref | + memref := codegen memRef: codegen regR index: codegen regA. + self + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithRatOffsetA + | memref | + memref := codegen memRef + base: codegen regR; + index: codegen regA; + scale: 1. + codegen + load: codegen regR + fromMem: + memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithS + codegen move: codegen regS to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithSPindex: index + | memref | + memref := codegen memRef: codegen regSP indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithSindex: index + | memref | + memref := codegen memRef: codegen regS indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithT + codegen move: codegen regT to: codegen regR +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithTIBatR + codegen load: codegen regR withTIBat: codegen regR +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithThreadVariableAtR + codegen load: codegen regR withThreadVariableAt: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithTrue + codegen move: codegen regTrue to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSPwithFP + codegen move: codegen regFP to: codegen regSP +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithAddressOfSatA + | memref | + memref := codegen + memRef: codegen regS + index: codegen regA + offsetImm: codegen wordSize negated. + codegen lea: codegen regS withMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regS + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithGindex: index + | memref | + memref := codegen memRef: codegen regG indexImm: index. + codegen + load: codegen regS + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithNil + codegen move: codegen regNil to: codegen regS +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + load: codegen regS + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTrueWithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regTrue + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithA + codegen move: codegen regA to: codegen regT +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithAindex: index + | memref | + memref := codegen memRef: codegen regA indexImm: index. + codegen + load: codegen regT + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithEindex: index + | memref | + memref := codegen memRef: codegen regE indexImm: index. + codegen + load: codegen regT + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regT + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithImmediate: imm + self load: codegen regT withImmediate: imm +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regT + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithR + codegen move: codegen regR to: codegen regT +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithTindex: index + | memref | + memref := codegen memRef: codegen regT indexImm: index. + codegen load: codegen regT fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadWithFalse: register + codegen move: codegen regFalse to: register +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadWithNil: register + codegen move: codegen regNil to: register +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadWithTrue: register + codegen move: codegen regTrue to: register +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadX0withRasDouble + codegen convert: codegen regR toDouble: codegen regX0 +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByte: dstReg from: srcBaseReg atIndexAt: srcIndexReg + codegen loadZeroExtendByte: dstReg from: srcBaseReg atIndexAt: srcIndexReg + +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByte: dstReg from: srcBaseReg atIndexImm: indexImm + + codegen + loadZeroExtendByte: dstReg + from: srcBaseReg + atIndexImm: indexImm +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByte: reg1 from: reg2 atOffset: offset + codegen loadZeroExtendByte: reg1 from: reg2 atOffset: offset +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByteRwithRatA + self loadZeroExtendByte: codegen regR from: codegen regR atIndexAt: codegen regA +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByteRwithRindex: index + #dontOptimize. + self loadZeroExtendByte: codegen regR from: codegen regR atIndexImm: index +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByteRwithSPatA + self loadZeroExtendByte: codegen regR from: codegen regSP atIndexAt: codegen regA +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByteTwithAindex: index + #dontOptimize. + self loadZeroExtendByte: codegen regT from: codegen regA atIndexImm: index +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendLongRwithRatA + | memref | + memref := codegen memRef32: codegen regR index: codegen regA. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendLongRwithRindex: index + | memref | + #dontOptimize. + memref := codegen memRef32: codegen regR indexImm: index. + codegen + load: codegen regR e + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendShortRwithRoffset: offset + codegen + loadZeroExtendShortRwithRoffset: offset +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +lock + codegen lock +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +loop: aBlock times: anInteger + | loop | + loop := self newLabel. + self loadTwithImmediate: anInteger; @ loop. + aBlock value. + self dec: codegen regT; shortJumpIfNotZeroTo: loop +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +loopTtimes: aBlock + | loop end | + loop := self newLabel. + end := self newLabel. + self + compareTwithImmediate: 0; + @ loop; + shortJumpIfEqualTo: end. + aBlock value. + self + dec: codegen regT; + shortJumpTo: loop; + @ end +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef + "Return clean instance of pointer-sized memory reference" + + ^ codegen memRef + +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef32: baseReg indexImm: indexImm + ^ codegen memRef32: baseReg indexImm: indexImm +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef8 + "Return clean instance of byte-sized memory reference" + + ^ codegen memRef8 +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef8: baseReg index: indexReg + ^ codegen memRef8: baseReg index: indexReg +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef: baseReg index: indexReg + ^ codegen memRef: baseReg index: indexReg +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef: baseReg indexImm: indexImm + ^ codegen memRef: baseReg indexImm: indexImm +! ! + +!GenericAssembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +move: srcReg to: dstReg + ^ codegen move: srcReg to: dstReg + +! ! + +!GenericAssembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveImm: imm to: dstReg + codegen moveImm: imm to: dstReg + +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveTslots + codegen moveTslots +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveX0toR + codegen moveDouble: codegen regX0 into: codegen regR +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +multiplyDoubleX0byX1 + codegen mulDouble: codegen regX0 by: codegen regX1 +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +multiplyRbyAwideningToA + codegen + multiply: codegen regR + by: codegen regA + wideningTo: codegen regA +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativeCode + ^(NativeCode withAll: literals) code: codegen memory bytes +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +or: src1AndDst with: src2 + ^ codegen or: src1AndDst with: src2 +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +or: source1andDest withImm: imm + codegen or: source1andDest withImm: imm +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +orRwithA + codegen or: codegen regR with: codegen regA + +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +pop: dstReg + codegen pop: dstReg +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popA + codegen pop: codegen regA +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popE + codegen pop: codegen regE +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popFP + codegen pop: codegen regFP +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popFalse + codegen pop: codegen regFalse +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popG + codegen pop: codegen regG +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popM + codegen pop: codegen regM +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popNil + codegen pop: codegen regNil +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popR + codegen pop: codegen regR +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popS + codegen pop: codegen regS +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +popSPindirect + | memref | + memref := codegen memRef: codegen regSP indexImm: 1. + codegen popIntoMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popT + codegen pop: codegen regT +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popTrue + codegen pop: codegen regTrue +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +push: srcReg + codegen push: srcReg + +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushA + codegen push: codegen regA +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushAatToffset: offset + | memref | + memref := codegen memRef: codegen regA index: codegen regT. + memref displacement: offset. + codegen pushMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushE + codegen push: codegen regE +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushFP + codegen push: codegen regFP +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushFalse + codegen push: codegen regFalse +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushG + codegen push: codegen regG +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushImm: imm + codegen pushImm: imm +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushIndirectR + | memref | + memref := codegen memRef: codegen regR indexImm: 1. + codegen pushMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushM + codegen push: codegen regM +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushNil + codegen push: codegen regNil +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushR + codegen push: codegen regR +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushS + codegen push: codegen regS +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushT + codegen push: codegen regT +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushTrue + codegen push: codegen regTrue +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +readFPUStatusOnA + codegen readFPUStatusOnA +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regA + ^codegen regA + +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regA8 + ^ codegen regA byte + +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regE + ^ codegen regE +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFP + ^ codegen regFP +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFalse + ^ codegen regFalse +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regG + ^ codegen regG +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regIP + ^ codegen regIP +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regM + ^ codegen regM +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regNil + ^ codegen regNil +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regR + ^ codegen regR +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regR8 + ^ codegen regR byte +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regS + ^ codegen regS +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regSP + ^ codegen regSP +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regT + ^ codegen regT +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regT8 + ^ codegen reg byte +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regTrue + ^ codegen regTrue +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regV + ^ codegen regV +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regX0 + "IEEE 754 double register" + ^ codegen regX0 +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regX1 + "IEEE 754 double register" + ^ codegen regX1 +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +renameByteRegisterIfNeeded: register preserving: preserved during: aBlock + codegen renameByteRegisterIfNeeded: register preserving: preserved during: aBlock +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +renameByteRegisterIfNeeded: register preserving: preserved1 preserving: preserved2 during: aBlock + codegen renameByteRegisterIfNeeded: register preserving: preserved1 preserving: preserved2 during: aBlock +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +reserveStackSlots: amount + codegen subImm: amount * codegen addressSize from: codegen regSP +! ! + +!GenericAssembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +reset + super reset. + codegen reset +! ! + +!GenericAssembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreCallerFrame + codegen + move: codegen regFP to: codegen regSP; + pop: codegen regFP +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +return + codegen return +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +roundDoubleX0intoX1 + codegen roundDouble: codegen regX0 into: codegen regX1 +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +scaleFloatOnRWithA + codegen scaleFloatOnRWithA +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +setRintegerBit + self setIntegerBit: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +setSafeRintegerBit + self setSafeIntegerBit: codegen regR +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLeft: srcAndDst byImm: count + codegen shiftLeft: srcAndDst byImm: count +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLeftRwithT + codegen shiftLeft: codegen regR by: codegen regT +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLogicalRright: count + codegen shiftRight: codegen regR byImm: count +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightArithmetic: srcAndDst by: countReg + codegen shiftRightArithmetic: srcAndDst by: countReg +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightArithmetic: srcAndDst byImm: count + codegen shiftRightArithmetic: srcAndDst byImm: count +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightRwithT + codegen shiftRightArithmetic: codegen regR by: codegen regT + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRleft: count + codegen shiftLeft: codegen regR byImm: count + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRright: count + codegen shiftRightArithmetic: codegen regR byImm: count + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftTright: count + codegen shiftRightArithmetic: codegen regT byImm: count + +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfCarryTo: label + codegen shortJumpIfCarryTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfEqualTo: label + codegen shortJumpIfEqualTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfNotCarryTo: label + codegen shortJumpIfNotCarryTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfNotEqualTo: label + codegen shortJumpIfNotEqualTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfSignTo: label + codegen shortJumpIfSignTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpTo: label + codegen shortJumpTo: label +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +sqrtDoubleX0 + codegen sqrtDouble: codegen regX0 into: codegen regX0 +! ! + +!GenericAssembler methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026 13:27:40'! +store: srcReg intoMem: dstMemRef + ^ codegen store: srcReg intoMem: dstMemRef +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeAinThreadVariableAtIndexR + codegen store: codegen regA intoThreadVariableAt: codegen regR +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeAinTindex: index + | memref | + memref := codegen memRef: codegen regT indexImm: index. + codegen + store: codegen regA + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeByteAinRindex: index + | memref | + memref := codegen memRef8: codegen regR indexImm: index. + codegen store: codegen regA byte intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeByteTinRatA + | memref | + memref := codegen memRef8: codegen regR index: codegen regA. + codegen store: codegen regT byte intoMem: memref +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeDoubleResultInRindirect + | memref | + memref := codegen memRef: codegen regR indexImm: 1. + codegen storeDoubleResultIntoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeEinRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + store: codegen regE + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLargeX0inA + | memref | + memref := codegen memRef64: codegen regA indexImm: 1. + codegen storeDouble: codegen regX0 intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLargeX0inT + | memref | + memref := codegen memRef64: codegen regT indexImm: 1. + codegen storeDouble: codegen regX0 intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLongTinRatA + | memref | + memref := codegen memRef32: codegen regR index: codegen regA. + codegen + store: codegen regT + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLongTinRatOffsetA + | memref | + memref := codegen memRef32: codegen regR offset: codegen regA. + codegen store: codegen regT long intoMem: memref +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeMXCSRintoA + codegen storeMXCSRintoA +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinAindex: index + | memref | + memref := codegen memRef: codegen regA indexImm: index. + codegen + store: codegen regR + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinEindex: index + | memref | + memref := codegen memRef: codegen regE indexImm: index. + codegen + store: codegen regR + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + store: codegen regR + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinSindex: index + | memref | + memref := codegen memRef: codegen regS indexImm: index. + codegen + store: codegen regR + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinTindex: index + | memref | + memref := codegen memRef: codegen regT indexImm: index. + codegen + store: codegen regR + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeShortAinRoffset: offset + | memref | + memref := codegen memRef16: codegen regR offsetImm: offset. + codegen store: codegen regA short intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeShortTinRatOffsetA + | memref | + memref := codegen memRef16: codegen regR offset: codegen regA. + codegen store: codegen regT short intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeSinRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + store: codegen regS + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTIBatRwithA + codegen store: codegen regA intoTIBat: codegen regR +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTinRatA + | memref | + memref := codegen memRef: codegen regR index: codegen regA. + codegen + store: codegen regT + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTinRatOffsetA + | memref | + memref := codegen memRef: codegen regR offset: codegen regA. + codegen store: codegen regT intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTinRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + store: codegen regT + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +sub: src2 from: src1AndDst + codegen sub: src2 from: src1AndDst +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subAfromR + codegen sub: codegen regA from: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subAfromT + codegen sub: codegen regA from: codegen regT +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026 13:27:40'! +subDoubleX1fromX0 + codegen subDouble: codegen regX1 from: codegen regX0 +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subFromRconstant: imm + codegen subImm: imm from: codegen regR +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subImm: imm from: srcAndDst + codegen subImm: imm from: srcAndDst +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +subTslotsToSP + codegen subTslotsToSP +! ! + +!GenericAssembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +platform: aNativizationPlatform + codegen := aNativizationPlatform newCodeGenerator. + super platform: aNativizationPlatform. +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +testIntegerBit: aRegister + codegen testIntegerBit: aRegister +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +testIntegerBitOf: aRegister + codegen test: aRegister byte withImm: 1 +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +testRintegerBit + codegen test: codegen regR byte withImm: 1 +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +testRwithR + codegen test: codegen regR with: codegen regR +! ! + +!GenericAssembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSize + ^codegen wordSize +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeTslots + codegen writeTslots +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +xorAwithR + codegen xor: codegen regA with: codegen regR +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +xorFPwithFP + codegen xor: codegen regFP with: codegen regFP +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +xorRwithA + codegen xor: codegen regR with: codegen regA +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'GenericAssembler class' category: #'Powerlang-Core-Assembly'! +GenericAssembler class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/AMD64CodeGenerator.Class.st b/modules/LMR/Nativizer/Assembly/Intel/AMD64CodeGenerator.Class.st new file mode 100644 index 00000000..af736f28 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/AMD64CodeGenerator.Class.st @@ -0,0 +1,1073 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #AMD64CodeGenerator category: #'Powerlang-Core-Assembler-Intel'! +CodeGenerator subclass: #AMD64CodeGenerator + instanceVariableNames: 'instruction operands1 operands2 operands3 pointer immediate encoder' + classVariableNames: '' + poolDictionaries: 'Registers' + category: 'Powerlang-Core-Assembler-Intel'! +!AMD64CodeGenerator commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!AMD64CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +add: src2 to: src1AndDst + self assemble: 'add' with: src1AndDst with: src2 + +! ! + +!AMD64CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addDouble: source1 to: source2andDest + self + assemble: 'addsd' + with: source2andDest + with: source1 +! ! + +!AMD64CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addImm: imm to: src2AndDst + self assemble: 'add' with: src2AndDst withImm: imm +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +and: src1AndDst with: source2 + self assemble: 'and' with: src1AndDst with: source2 + +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +and: src1AndDst withImm: imm + + (imm between: -128 and: -1) ifTrue: [ + "When `imm` is a small negative, we can safely + and bits only in lower part of the 64 bit register + since higher bits of immediate are all ones anyway. + This helps to generate shorter code on x86." + self assemble: 'and' with: src1AndDst byte withImm: imm + ] ifFalse: [ + self assemble: 'and' with: src1AndDst withImm: imm + ]. + +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble + encoder reset; writeEncodingOn: memory +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble: mnemonic + instruction mnemonic: mnemonic; operands: #(). + self assemble +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble: mnemonic with: op + | op1 | + op1 := op isInteger ifTrue: [immediate value: op] ifFalse: [op]. + operands1 at: 1 put: op1. + instruction mnemonic: mnemonic; operands: operands1. + self assemble +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble: mnemonic with: op1 with: op2 + | op | + op := op2 isInteger ifTrue: [immediate value: op2] ifFalse: [op2]. + operands2 + at: 1 put: op1; + at: 2 put: op. + instruction mnemonic: mnemonic; operands: operands2. + self assemble +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble: mnemonic with: op1 with: op2 with: op3 + | op | + op := op3 isInteger ifTrue: [immediate value: op3] ifFalse: [op3]. + operands3 + at: 1 put: op1; + at: 2 put: op2; + at: 3 put: op. + instruction mnemonic: mnemonic; operands: operands3. + self assemble +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble: mnemonic with: op1 withImm64: op2 + | v | + v := self regV. + self + assemble: 'mov' with: v with: op2; + assemble: mnemonic with: op1 with: v +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble: mnemonic with: op1 withImm: imm + immediate value: imm. + (immediate length <= 32 or: [mnemonic = 'mov' and: [op1 class == Register]]) + ifTrue: [self assemble: mnemonic with: op1 with: immediate] + ifFalse: [self assemble: mnemonic with: op1 withImm64: immediate] +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble: mnemonic withImm64: op1 + | v | + v := self regV. + self + assemble: 'mov' with: v with: op1; + assemble: mnemonic with: v +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble: mnemonic withImm: imm + immediate value: imm. + immediate length <= 32 + ifTrue: [self assemble: mnemonic with: immediate] + ifFalse: [self assemble: mnemonic withImm64: immediate] +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble: mnemonic withReg: reg index: index + pointer + reset; + length: self addressLength; + base: reg; + displacement: index - 1 * wordSize. + self assemble: mnemonic with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemble: mnemonic withReg: dst withReg: src index: index + pointer + reset; + length: self addressLength; + base: src; + displacement: index - 1 * wordSize. + self assemble: mnemonic with: dst with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleByte: byte + memory nextBytePut: byte +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBytes: aByteArray + memory nextBytesPut: aByteArray +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBytes: value count: count + self ASSERT: value isInteger. + self ASSERT:(count == 4 or:[ count == 8 ]). + + count == 4 ifTrue: [ + memory nextLongPut: value + ] ifFalse: [ + memory nextLargePut: value + ]. + +! ! + +!AMD64CodeGenerator methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:27:40'! +breakpoint + self assemble: 'int' with: 3 +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +call: srcReg + self assemble: 'call' with: srcReg +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +callIndirect: aMemRef + self assemble: 'call' with: aMemRef +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearFPUFlags + self assemble: 'fnclex' +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearHigh32: srcAndDstReg + self assemble: 'mov' with: srcAndDstReg e with: srcAndDstReg e +! ! + +!AMD64CodeGenerator methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: reg1 with: reg2 + self assemble: 'cmp' with: reg1 with: reg2 +! ! + +!AMD64CodeGenerator methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: reg1 withImm: imm + #imm8. + #imm32. + self assemble: 'cmp' with: reg1 withImm: imm +! ! + +!AMD64CodeGenerator methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +compare: reg1 withMem: aMemRef + self assemble: 'cmp' with: reg1 with: aMemRef +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareEqualDoubleX0withAindirect + pointer + reset; + length: 64; + base: self regA. + self + assemble: 'cmpsd' + with: self regX0 + with: pointer + with: 0 +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareLessThanDoubleX0withAindirect + pointer + reset; + length: 64; + base: self regA. + self + assemble: 'cmpsd' + with: self regX0 + with: pointer + with: 1 +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +convert: src toDouble: dst + self assemble: 'cvtsi2sd' with: dst with: src +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +dec: srcAndDstReg + self assemble: 'dec' with: srcAndDstReg +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +decMem: aMemRef + self assemble: 'dec' with: aMemRef + +! ! + +!AMD64CodeGenerator methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +disassembledText32 + ^self nativeCode disassembledText32 +! ! + +!AMD64CodeGenerator methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +disassembledText64 + ^self nativeCode disassembledText64 +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +divDouble: src1andDstReg by: src2reg + self + assemble: 'divsd' + with: src1andDstReg + with: src2reg +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +divide: srcAndDstReg extendingTo: extReg by: divisorReg + | conversion | + self + ASSERT: srcAndDstReg r == rax; + ASSERT: extReg r == rdx. + conversion := wordSize = 8 + ifTrue: [ 'cqo' ] + ifFalse: [ 'cdq' ]. + self + assemble: conversion; + assemble: 'idiv' with: divisorReg +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +dropTopOfFPU + " + fstp st(0) + " + self assembleBytes: #[16rDD 16rD8] +! ! + +!AMD64CodeGenerator methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +exchange: op1 with: op2 + self assemble: 'xchg' with: op1 with: op2 +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +exchange: srcAndDstReg withMem: aMemRef + self assemble: 'xchg' with: aMemRef with: srcAndDstReg +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +inc: srcAndDstReg + self assemble: 'inc' with: srcAndDstReg +! ! + +!AMD64CodeGenerator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + instruction := ISAInstruction new. + operands1 := Array new: 1. + operands2 := Array new: 2. + operands3 := Array new: 3. + immediate := ISAImmediate new. + pointer := MemoryOperand new. + encoder := instruction encoder. + +! ! + +!AMD64CodeGenerator methodsFor: 'private - jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jump: mnemonic to: label size: n + | placeholder end | + placeholder := 1 bitShift: n - 1 * 8. + self assemble: mnemonic with: placeholder. + end := memory position. + memory + skip: -1; + nextPut: 0; + skip: n negated; + addRelativeFixup: label size: n; + position: end +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfEqualTo: label + self nearJump: 'jz' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfGreaterOrEqualSignedTo: label + self nearJump: 'jge' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfGreaterSignedTo: label + self nearJump: 'jg' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfLessOrEqualSignedTo: label + self nearJump: 'jle' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfLessSignedTo: label + self nearJump: 'jl' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfNotEqualTo: label + self nearJump: 'jnz' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfNotZeroTo: label + self jumpIfNotEqualTo: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfOverflowTo: label + self nearJump: 'jo' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfSignTo: label + self nearJump: 'js' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpIfZeroTo: label + self jumpIfEqualTo: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpTo: label + self nearJump: 'jmp' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpToMem: aMemRef + self assemble: 'jmp' with: aMemRef +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +lea: dstReg withMem: srcMemRef + self assemble: 'lea' with: dstReg with: srcMemRef +! ! + +!AMD64CodeGenerator methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +leadingRzeroCount + " + lzcnt is a special x64 extension: it puts the REX + prefix after the first opcode byte. Our x64 + encoder doesn't support that, so we fix the + bytes by hand + " + | pos | + pos := self currentAddress. + self assemble: 'lzcnt' with: self regR with: self regR. + memory + writeByte: 16rF3 at: pos; + writeByte: 16r48 at: pos + 1 +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: dstReg convertingDoubleToIntegerFromMem: srcMemRef + self assemble: 'cvttsd2si' with: dstReg with: srcMemRef +! ! + +!AMD64CodeGenerator methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: dstReg fromMem: srcMemRef + | adjusted | + adjusted := dstReg forLength: srcMemRef length. + self + assemble: 'mov' + with: adjusted + with: srcMemRef +! ! + +!AMD64CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: dstReg withTIBat: indexReg + | seg | + seg := wordSize = 8 + ifTrue: [ gs ] + ifFalse: [ fs ]. + pointer + reset; + length: self addressLength; + index: indexReg; + scale: wordSize; + segment: seg. + self assemble: 'mov' with: dstReg with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +load: dstReg withThreadVariableAt: indexReg + pointer + reset; + length: self addressLength; + index: indexReg; + scale: wordSize. + wordSize = 8 + ifTrue: [ pointer + segment: gs; + displacement: 16r1480 ] + ifFalse: [ pointer + segment: fs; + displacement: 16rE10 ]. + self assemble: 'mov' with: dstReg with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadDouble: dstReg fromMem: srcMemRef + self ASSERT: srcMemRef sizeInBits == 64. + self + assemble: 'movq' + with: dstReg + with: srcMemRef + +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLongMwithIPoffset: anInteger + | instsize | + #dontOptimize. + instsize := 6. + pointer + reset; + length: 32; + base: self regIP; + displacement: anInteger - instsize. + self assemble: 'mov' with: self regM e with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMXCSRfromA + pointer + reset; + length: 32; + base: self regA. + self assemble: 'ldmxcsr' with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByte: reg1 from: reg2 atIndexAt: reg3 + pointer + reset; + length: 8; + base: reg2; + index: reg3; + displacement: -1. + self assemble: 'movzx' with: reg1 with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByte: reg1 from: reg2 atIndexImm: index + self loadZeroExtendByte: reg1 from: reg2 atOffset: index - 1 +! ! + +!AMD64CodeGenerator methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByte: reg1 from: reg2 atOffset: offset + pointer + reset; + length: 8; + base: reg2; + displacement: offset. + self assemble: 'movzx' with: reg1 with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendShortRwithRoffset: offset + pointer + reset; + length: 16; + base: self regR; + displacement: offset. + self assemble: 'movzx' with: self regR with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +lock + self assembleByte: 16rF0 +! ! + +!AMD64CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:27:40'! +memRef + ^ MemoryOperand new + length: self addressBitSize +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +move: srcReg to: dstReg + self ASSERT: (srcReg class = Register and: [dstReg class = Register]). + self assemble: 'mov' with: dstReg with: srcReg + +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveDouble: srcReg into: dstReg + | mov | + + mov := wordSize = 8 ifTrue: [ + 'movq' + ] ifFalse: [ 'movd' ]. + self + assemble: mov + with: dstReg + with: srcReg +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveImm: imm to: dstReg + self ASSERT: (imm isInteger and: [dstReg class = Register]). + self assemble: 'mov' with: dstReg with: imm + +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveTslots + | rep mnemonic | + rep := 16rF3. + mnemonic := wordSize = 8 + ifTrue: [ 'movsq' ] + ifFalse: [ 'movsd' ]. + self + assembleByte: rep; + assemble: mnemonic +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +mulDouble: src1andDstReg by: src2reg + self + assemble: 'mulsd' + with: src1andDstReg + with: src2reg +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +multiply: src1AndDstLoReg by: src2reg wideningTo: dstHiReg + self + ASSERT: src1AndDstLoReg r == rax; + ASSERT: dstHiReg r == rdx. + self assemble: 'imul' with: src2reg +! ! + +!AMD64CodeGenerator methodsFor: 'private - jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +nearJump: mnemonic to: label + self jump: mnemonic to: label size: 4 +! ! + +!AMD64CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +nop + self assemble: 'nop' +! ! + +!AMD64CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +nop2 + memory nextPutAll: #[16r66 16r90] +! ! + +!AMD64CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +nop3 + memory nextPutAll: #[16r0F 16r1F 16r00] +! ! + +!AMD64CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +nop4 + memory nextPutAll: #[16r0F 16r1F 16r40 16r00] +! ! + +!AMD64CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +nop5 + memory nextPutAll: #[16r0F 16r1F 16r44 16r00 16r00] +! ! + +!AMD64CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +nop6 + memory nextPutAll: #[16r66 16r0F 16r1F 16r44 16r00 16r00] +! ! + +!AMD64CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +nop7 + memory nextPutAll: #[16r0F 16r1F 16r80 16r00 16r00 16r00 16r00] +! ! + +!AMD64CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +nop8 + memory nextPutAll: #[16r0F 16r1F 16r84 16r00 16r00 16r00 16r00 16r00] +! ! + +!AMD64CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +nop9 + memory nextPutAll: #[16r66 16r0F 16r1F 16r84 16r00 16r00 16r00 16r00 16r00] +! ! + +!AMD64CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026 13:27:40'! +nop: count + " + ShellDLL current openWebPage: 'http://www.felixcloutier.com/x86/NOP.html' + " + | r | + r := count. + r >= 9 ifTrue: [ + r // 9 timesRepeat: [self nop9]. + r := r \\ 9]. + r = 8 ifTrue: [^self nop8]. + r = 7 ifTrue: [^self nop7]. + r = 6 ifTrue: [^self nop6]. + r = 5 ifTrue: [^self nop5]. + r = 4 ifTrue: [^self nop4]. + r = 3 ifTrue: [^self nop3]. + r = 2 ifTrue: [^self nop2]. + r = 1 ifTrue: [^self nop]. + +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +or: src1AndDst with: src2 + self assemble: 'or' with: src1AndDst with: src2 + +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +or: src1AndDst withImm: imm + + (imm between: 0 and: 127) ifTrue: [ + "When `imm` is a small POSITIVE, we can safely + or bits only in lower part of the 64 bit register + since higher bits of immediate are all zeros anyway. + This helps to generate shorter code on x86." + self assemble: 'or' with: src1AndDst byte withImm: imm + ] ifFalse: [ + self assemble: 'or' with: src1AndDst withImm: imm + ]. + +! ! + +!AMD64CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pop: dstReg + self assemble: 'pop' with: dstReg + +! ! + +!AMD64CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popIntoMem: dstMemRef + self assemble: 'pop' with: dstMemRef +! ! + +!AMD64CodeGenerator methodsFor: 'printing & storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + aStream print: self class; cr; cr; + nextPutAll: memory bytes disassembledAmd64 +! ! + +!AMD64CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +push: srcReg + self assemble: 'push' with: srcReg + +! ! + +!AMD64CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushAOnFPUStack + pointer reset; length: 64; base: self regA. + self assemble: 'fld' with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushImm: imm + #imm8. + #imm32. + self assemble: 'push' withImm: imm +! ! + +!AMD64CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushMem: aMemRef + self push: aMemRef +! ! + +!AMD64CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushROnFPUStack + pointer reset; length: 64; base: self regR. + self assemble: 'fld' with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +readFPUStatusOnA + pointer + reset; + length: 16; + base: self regA. + self assemble: 'fstsw' with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +renameByteRegisterIfNeeded: register preserving: preserved during: aBlock + self + renameByteRegisterIfNeeded: register + preserving: preserved + preserving: nil + during: aBlock +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +renameByteRegisterIfNeeded: register preserving: preserved1 preserving: preserved2 during: aBlock + | final | + (self addressSize !!= 4 or: [register byte isLongModeOld8BitRegister not]) + ifTrue: [aBlock value: register] + ifFalse: [ + final := self renameRegisterPreserving: preserved1 preserving: preserved2. + self exchange: register e with: final. + aBlock value: final. + self exchange: final with: register e] +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +renameRegisterPreserving: preserved1 preserving: preserved2 + preserved1 == self regR + ifTrue: [preserved2 == self regA + ifTrue: [^self regT] + ifFalse: [^self regA]]. + preserved2 == self regR + ifTrue: [preserved1 == self regA + ifTrue: [^self regT] + ifFalse: [^self regA]]. + ^self regR +! ! + +!AMD64CodeGenerator methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! +return + self assemble: 'ret' +! ! + +!AMD64CodeGenerator methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! +return: anInteger + anInteger = 0 + ifTrue: [self assemble: 'ret'] + ifFalse: [self assemble: 'ret' with: anInteger * self addressSize] +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +roundDouble: srcReg into: dstReg + self + assemble: 'roundsd' + with: dstReg + with: srcReg + with: 3 +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +scaleFloatOnRWithA + self + pushAOnFPUStack; + pushROnFPUStack; + assemble: 'fscale'. + pointer + reset; + length: 64; + base: self regR. + self + assemble: 'fstp' with: pointer; + dropTopOfFPU +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLeft: srcAndDst by: countReg + self ASSERT: countReg r = rcx. + self assemble: 'sal' with: srcAndDst with: countReg b +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLeft: srcAndDst byImm: count + self ASSERT: (count between: 0 and: srcAndDst length - 1). + self assemble: 'sal' with: srcAndDst withImm: count +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRight: srcAndDst by: countReg + self ASSERT: countReg r = rcx. + self assemble: 'sar' with: srcAndDst with: countReg b +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRight: srcAndDst byImm: count + self ASSERT: (count between: 0 and: srcAndDst length - 1). + self assemble: 'shr' with: srcAndDst withImm: count +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightArithmetic: srcAndDst by: countReg + self ASSERT: countReg r = rcx. + self assemble: 'sar' with: srcAndDst with: countReg b +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightArithmetic: srcAndDst byImm: count + self ASSERT: (count between: 0 and: srcAndDst length - 1). + self assemble: 'sar' with: srcAndDst withImm: count +! ! + +!AMD64CodeGenerator methodsFor: 'private - jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJump: mnemonic to: label + self jump: mnemonic to: label size: 1 +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfCarryTo: label + self shortJump: 'jc' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfEqualTo: label + self shortJump: 'jz' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfNotCarryTo: label + self shortJump: 'jnc' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfNotEqualTo: label + self shortJump: 'jnz' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpIfSignTo: label + self shortJump: 'js' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +shortJumpTo: label + self shortJump: 'jmp' to: label +! ! + +!AMD64CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +sqrtDouble: srcReg into: dstReg + self + assemble: 'sqrtsd' + with: srcReg + with: dstReg +! ! + +!AMD64CodeGenerator methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026 13:27:40'! +store: srcReg intoMem: dstMemRef + | adjusted | + adjusted := srcReg forLength: dstMemRef length. + self + assemble: 'mov' + with: dstMemRef + with: adjusted +! ! + +!AMD64CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +store: srcReg intoTIBat: indexReg + | seg | + seg := wordSize = 8 + ifTrue: [ gs ] + ifFalse: [ fs ]. + pointer + reset; + length: self addressLength; + index: indexReg; + scale: wordSize; + segment: seg. + self assemble: 'mov' with: pointer with: srcReg +! ! + +!AMD64CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026 13:27:40'! +store: srcReg intoThreadVariableAt: indexReg + pointer + reset; + length: self addressLength; + index: indexReg; + scale: wordSize. + wordSize = 8 + ifTrue: [ pointer + segment: gs; + displacement: 16r1480 ] + ifFalse: [ pointer + segment: fs; + displacement: 16rE10 ]. + self assemble: 'mov' with: pointer with: srcReg +! ! + +!AMD64CodeGenerator methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeByte: byte in: reg2 offset: offset + pointer + reset; + length: 8; + base: reg2; + displacement: offset. + self assemble: 'mov' with: pointer with: byte +! ! + +!AMD64CodeGenerator methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeDouble: srcReg intoMem: dstMemRef + self ASSERT: dstMemRef sizeInBits == 64. + self + assemble: 'movq' + with: dstMemRef + with: srcReg + +! ! + +!AMD64CodeGenerator methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeDoubleResultIntoMem: dstMemRef + wordSize = 8 + ifTrue: + [ self assemble: 'movq' with: dstMemRef with: self regX0 ] + ifFalse: [ self assemble: 'fstp' with: dstMemRef ] +! ! + +!AMD64CodeGenerator methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeImm: imm intoMem: dstMemRef + self + assemble: 'mov' + with: dstMemRef + withImm: imm + +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeMXCSRintoA + pointer + reset; + length: 32; + base: self regA. + self assemble: 'stmxcsr' with: pointer +! ! + +!AMD64CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +sub: src1 from: src2AndDst + self assemble: 'sub' with: src2AndDst with: src1 + +! ! + +!AMD64CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subDouble: src1 from: src2AndDst + self + assemble: 'subsd' + with: src2AndDst + with: src1 +! ! + +!AMD64CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subImm: imm from: srcAndDst + self assemble: 'sub' with: srcAndDst withImm: imm + +! ! + +!AMD64CodeGenerator methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +subTslotsToSP + self assemble: 'neg' with: self regT. + pointer + reset; + length: self addressLength; + base: self regSP; + index: self regT; + scale: self regSP sizeInBytes. + self + assemble: 'lea' with: self regSP with: pointer; + assemble: 'neg' with: self regT +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +test: src1Reg with: src2Reg + self assemble: 'test' with: src1Reg with: src2Reg +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +test: srcReg withImm: imm + self assemble: 'test' with: srcReg with: imm +! ! + +!AMD64CodeGenerator methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +testIntegerBit: op1 + | op | + op := op1 byte. + (self addressSize = 4 and: [op isLongModeOld8BitRegister]) + ifTrue: [op := op1]. + self assemble: 'test' with: op with: 1 +! ! + +!AMD64CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSize: anInteger + super wordSize: anInteger. + encoder wordSize: anInteger +! ! + +!AMD64CodeGenerator methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeTslots + | rep mnemonic | + rep := 16rF3. + mnemonic := wordSize = 8 + ifTrue: [ 'stosq' ] + ifFalse: [ 'stosd' ]. + self + assembleByte: rep; + assemble: mnemonic +! ! + +!AMD64CodeGenerator methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026 13:27:40'! +xor: src1AndDst with: src2 + self assemble: 'xor' with: src1AndDst with: src2 + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'AMD64CodeGenerator class' category: #'Powerlang-Core-Assembler-Intel'! +AMD64CodeGenerator class + instanceVariableNames: ''! + + +AMD64CodeGenerator initialize! + diff --git a/modules/LMR/Nativizer/Assembly/Intel/AMD64TemplateAssembler.Class.st b/modules/LMR/Nativizer/Assembly/Intel/AMD64TemplateAssembler.Class.st new file mode 100644 index 00000000..85c9cd27 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/AMD64TemplateAssembler.Class.st @@ -0,0 +1,1301 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #AMD64TemplateAssembler category: #'Powerlang-Core-Assembler-Intel'! +Assembler subclass: #AMD64TemplateAssembler + instanceVariableNames: 'wordSize buffer' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!AMD64TemplateAssembler commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addAtoR + self assembleBytes: #[16r48 16r1 16rD0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addDoubleX1toX0 + self assembleBytes: #[16rF2 16rF 16r58 16rC1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addSPwithImmediate: imm + (-128 <= imm and: [ imm < 128 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16r83 16rC4]; + assembleByte: imm ]. + (-16r80000000 <= imm and: [ imm < 16r80000000 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16r81 16rC4]; + assembleBytes: imm count: 4 ]. + self + assembleBytes: #[16r49 16rBB]; + assembleBytes: imm count: 8; + assembleBytes: #[16r4C 16r1 16rDC] +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +addTtoR + self assembleBytes: #[16r48 16r1 16rC8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +andRwithA + self assembleBytes: #[16r48 16r21 16rD0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +andRwithImmediate: imm + (-128 <= imm and: [ imm < 128 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16r83 16rE0]; + assembleByte: imm ]. + (-16r80000000 <= imm and: [ imm < 16r80000000 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16r25]; + assembleBytes: imm count: 4 ]. + self + assembleBytes: #[16r49 16rBB]; + assembleBytes: imm count: 8; + assembleBytes: #[16r4C 16r21 16rD8] +! ! + +!AMD64TemplateAssembler methodsFor: 'relocation' stamp: 'KenD 28/Jun/2026 13:27:40'! +applyFixups + buffer applyFixupsWith: self +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleByte: anInteger + buffer nextBytePut: anInteger +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBytes: aByteArray + buffer nextBytesPut: aByteArray +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBytes: value count: count + self ASSERT: value isInteger. + self ASSERT:(count == 4 or:[ count == 8 ]). + + count == 4 + ifTrue: [ buffer nextLongPut: value] + ifFalse: [ buffer nextLargePut: value] +! ! + +!AMD64TemplateAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildFrame + self assembleBytes: #[16r55 16r48 16r89 16rE5]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +callIndirectA + self assembleBytes: #[16rFF 16r12]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +callR + self assembleBytes: #[16rFF 16rD0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearFPUFlags + self assembleBytes: #[16rDB 16rE2]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearRhigh32 + self assembleBytes: #[16r89 16rC0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearRintegerBit + self assembleBytes: #[16r48 16rFF 16rC8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearSafeRintegerBit + self assembleBytes: #[16r24 16rFE]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareEqualDoubleX0withAindirect + self assembleBytes: #[16rF2 16rF 16rC2 16r2 16r0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareLessThanDoubleX0withAindirect + self assembleBytes: #[16rF2 16rF 16rC2 16r2 16r1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithA + self assembleBytes: #[16r48 16r39 16rD0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareRwithImmediate: imm + (-128 <= imm and: [ imm < 128 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16r83 16rF8]; + assembleByte: imm ]. + (-16r80000000 <= imm and: [ imm < 16r80000000 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16r3D]; + assembleBytes: imm count: 4 ]. + self + assembleBytes: #[16r49 16rBB]; + assembleBytes: imm count: 8; + assembleBytes: #[16r4C 16r39 16rD8] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareSwithTindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r3B 16r31]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r3B 16r71]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r3B 16rB1]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compareTwithImmediate: imm + (-128 <= imm and: [ imm < 128 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16r83 16rF9]; + assembleByte: imm ]. + (-16r80000000 <= imm and: [ imm < 16r80000000 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16r81 16rF9]; + assembleBytes: imm count: 4 ]. + self + assembleBytes: #[16r49 16rBB]; + assembleBytes: imm count: 8; + assembleBytes: #[16r4C 16r39 16rD9] +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertAtoNativeInteger + self assembleBytes: #[16r48 16rD1 16rFA]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertRtoNativeInteger + self assembleBytes: #[16r48 16rD1 16rF8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertRtoSmallInteger + self assembleBytes: #[16r48 16rD1 16rE0 16r48 16rFF 16rC0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +convertTtoNativeInteger + self assembleBytes: #[16r48 16rD1 16rF9]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +divideDoubleX0byX1 + self assembleBytes: #[16rF2 16rF 16r5E 16rC1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +dropTopOfFPU + self assembleBytes: #[16rDD 16rD8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +exchangeRindirectWithT + self assembleBytes: #[16r48 16r87 16r8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +extendRtoAandDividebyT + self assembleBytes: #[16r48 16r99 16r48 16rF7 16rF9]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeS + self assembleBytes: #[16r48 16r89 16rC6]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithAindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r12]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r52]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r92]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithEindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r17]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r57]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r97]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithFPindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r55 16r0]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r55]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r95]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithFalse + self assembleBytes: #[16r4C 16r89 16rF2] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithImmediate: imm + (-16r80000000 <= imm and: [ imm < 16r80000000 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16rC7 16rC2]; + assembleBytes: imm count: 4 ]. + self + assembleBytes: #[16r48 16rBA]; + assembleBytes: imm count: 8 +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithNil + self assembleBytes: #[16r4C 16r89 16rE2] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithR + self assembleBytes: #[16r48 16r89 16rC2]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithRoffsetAtA + self assembleBytes: #[16r48 16r8B 16r14 16r10]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithS + self assembleBytes: #[16r48 16r89 16rF2]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithSindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r16]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r56]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r96]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithTrue + self assembleBytes: #[16r4C 16r89 16rEA] +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithAddressOfRatA + self assembleBytes: #[16r48 16r8D 16r7C 16rD0 16rF8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithFPindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r7D 16r0]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r7D]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16rBD]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadEwithR + self assembleBytes: #[16r48 16r89 16rC7]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadFPwithR + self assembleBytes: #[16r48 16r89 16rC5]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadFPwithSP + self assembleBytes: #[16r48 16r89 16rE5]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLargeX0withRindirect + self assembleBytes: #[16r66 16r48 16rF 16r6E 16r0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLargeX1withAindirect + self assembleBytes: #[16r66 16r48 16rF 16r6E 16rA]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLongRwithRatOffsetA + self assembleBytes: #[16r8B 16r4 16r10]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMXCSRfromA + self assembleBytes: #[16rF 16rAE 16r12]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadMwithA + self assembleBytes: #[16r48 16r89 16rD3] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRconvertingDoublePointedByR + self assembleBytes: #[16rF2 16r48 16rF 16r2C 16r0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithA + self assembleBytes: #[16r48 16r89 16rD0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithArgPointer + self assembleBytes: #[16r48 16r8D 16r45 16r10]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithE + self assembleBytes: #[16r48 16r89 16rF8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithEindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r7]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r47]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r87]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithFP + self assembleBytes: #[16r48 16r89 16rE8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithFPindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r45 16r0]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r45]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r85]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithFalse + self assembleBytes: #[16r4C 16r89 16rF0] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithImmediate: imm + (-16r80000000 <= imm and: [ imm < 16r80000000 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16rC7 16rC0]; + assembleBytes: imm count: 4 ]. + self + assembleBytes: #[16r48 16rB8]; + assembleBytes: imm count: 8 +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithM + self assembleBytes: #[16r48 16r89 16rD8] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithMindex: index + | offset | + offset := (index - 1) * wordSize. + offset = 0 + ifTrue: [ ^ self assembleBytes: #[16r48 16r8B 16r03] ]. + (-128 <= offset and: [ offset < 128 ]) + ifTrue: [ self + assembleBytes: #[16r48 16r8B 16r43]; + assembleByte: offset ] + ifFalse: [ self + assembleBytes: #[16r48 16r8B 16r83]; + assembleBytes: offset count: 4 ] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithNil + self assembleBytes: #[16r4C 16r89 16rE0] +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithRatA + self assembleBytes: #[16r48 16r8B 16r44 16rD0 16rF8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithRatOffsetA + self assembleBytes: #[16r48 16r8B 16r4 16r10]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithRindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r0]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r40]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r80]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithS + self assembleBytes: #[16r48 16r89 16rF0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithSPindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r4 16r24]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r44 16r24]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r84 16r24]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithSindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r6]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r46]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r86]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithT + self assembleBytes: #[16r48 16r89 16rC8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithTIBatR + self assembleBytes: #[16r65 16r48 16r8B 16r4 16rC5 16r0 16r0 16r0 16r0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithThreadVariableAtR + self assembleBytes: #[16r65 16r48 16r8B 16r4 16rC5 16r80 16r14 16r0 16r0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithTrue + self assembleBytes: #[16r4C 16r89 16rE8] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSPwithFP + self assembleBytes: #[16r48 16r89 16rEC]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithAddressOfSatA + self assembleBytes: #[16r48 16r8D 16r74 16rD6 16rF8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithFPindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r75 16r0]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r75]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16rB5]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadSwithRindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r30]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r70]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16rB0]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithA + self assembleBytes: #[16r48 16r89 16rD1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithAindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16rA]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r4A]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r8A]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithEindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16rF]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r4F]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r8F]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithFPindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r4D 16r0]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r4D]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r8D]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithImmediate: imm + (-16r80000000 <= imm and: [ imm < 16r80000000 ]) + ifTrue: [ ^ self + assembleBytes: #[16r48 16rC7 16rC1]; + assembleBytes: imm count: 4 ]. + self + assembleBytes: #[16r48 16rB9]; + assembleBytes: imm count: 8 +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithR + self assembleBytes: #[16r48 16r89 16rC1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithTindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r8B 16r9]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r8B 16r49]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r8B 16r89]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadX0withRasDouble + self assembleBytes: #[16rF2 16r48 16rF 16r2A 16rC0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByteRwithRatA + self assembleBytes: #[16r48 16rF 16rB6 16r44 16r10 16rFF]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendByteRwithSPatA + self assembleBytes: #[16r48 16rF 16rB6 16r44 16r14 16rFF]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadZeroExtendLongRwithRatA + self assembleBytes: #[16r8B 16r44 16r90 16rFC]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +lock + self assembleBytes: #[16rF0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'opcodes - integer related' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveTslots + self assembleBytes: #[16rF3 16r48 16rA5]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveX0toR + self assembleBytes: #[16r66 16r48 16rF 16r7E 16rC0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +multiplyDoubleX0byX1 + self assembleBytes: #[16rF2 16rF 16r59 16rC1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +multiplyRbyAwideningToA + self assembleBytes: #[16r48 16rF7 16rEA]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativeCode + ^ NativeCode new code: buffer bytes +! ! + +!AMD64TemplateAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +orRwithA + self assembleBytes: #[16r48 16r9 16rD0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popA + self assembleBytes: #[16r5A]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popE + self assembleBytes: #[16r5F]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popFP + self assembleBytes: #[16r5D]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popR + self assembleBytes: #[16r58]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popS + self assembleBytes: #[16r5E]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popSPindirect + self assembleBytes: #[16r8F 16r4 16r24]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +popT + self assembleBytes: #[16r59]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushA + self assembleBytes: #[16r52]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushAOnFPUStack + self assembleBytes: #[16rDD 16r2]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushE + self assembleBytes: #[16r57]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushFP + self assembleBytes: #[16r55]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushImmediate: imm + (-128 <= imm and: [ imm < 128 ]) + ifTrue: [ ^ self + assembleBytes: #[16r6A]; + assembleByte: imm ]. + (-16r80000000 <= imm and: [ imm < 16r80000000 ]) + ifTrue: [ ^ self + assembleBytes: #[16r68]; + assembleBytes: imm count: 4 ]. + self + assembleBytes: #[16r49 16rBB]; + assembleBytes: imm count: 8; + assembleBytes: #[16r41 16r53] +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushIndirectR + self assembleBytes: #[16rFF 16r30]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushR + self assembleBytes: #[16r50]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushROnFPUStack + self assembleBytes: #[16rDD 16r0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushS + self assembleBytes: #[16r56]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushT + self assembleBytes: #[16r51]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreCallerEnvironment + self assembleBytes: #[16r48 16r8B 16r7D 16rE8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreCallerFrame + self assembleBytes: #[16r48 16r89 16rEC 16r5D]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreCallerM + self assembleBytes: #[16r48 16r8B 16r5D 16rF0] +! ! + +!AMD64TemplateAssembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreCallerSelf + self assembleBytes: #[16r48 16r8B 16r75 16rF8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! +return + self assembleBytes: #[16rC3] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +roundDoubleX0intoX1 + self assembleBytes: #[16r66 16rF 16r3A 16rB 16rC8 16r3]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +saveCallerFrame + self assembleBytes: #[16r55 16r48 16r89 16rE5]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +scaleFloatOnRWithA + self assembleBytes: #[16rDD 16r2 16rDD 16r0 16rD9 16rFD 16rDD 16r18 16rDD 16rD8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +setRintegerBit + self assembleBytes: #[16rC 16r1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +setSafeRintegerBit + self assembleBytes: #[16rC 16r1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftLeftRwithT + self assembleBytes: #[16r48 16rD3 16rE0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +shiftRightRwithT + self assembleBytes: #[16r48 16rD3 16rF8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +sqrtDoubleX0 + self assembleBytes: #[16rF2 16rF 16r51 16rC0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeAinThreadVariableAtIndexR + self assembleBytes: #[16r65 16r48 16r89 16r14 16rC5 16r80 16r14 16r0 16r0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeAinTindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r89 16r11]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r89 16r51]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r89 16r91]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeByteTinRatA + self assembleBytes: #[16r88 16r4C 16r10 16rFF]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeDoubleResultInRindirect + self assembleBytes: #[16r66 16r48 16rF 16r7E 16r0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeEinRindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r89 16r38]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r89 16r78]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r89 16rB8]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLargeX0inA + self assembleBytes: #[16r66 16r48 16rF 16r7E 16r2]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLargeX0inT + self assembleBytes: #[16r66 16r48 16rF 16r7E 16r1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLongTinRatA + self assembleBytes: #[16r89 16r4C 16r90 16rFC]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeLongTinRatOffsetA + self assembleBytes: #[16r89 16rC 16r10]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeMXCSRintoA + self assembleBytes: #[16rF 16rAE 16r1A]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinAindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r89 16r2]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r89 16r42]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r89 16r82]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinEindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r89 16r7]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r89 16r47]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r89 16r87]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinFPindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r89 16r45 16r0]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r89 16r45]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r89 16r85]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinSindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r89 16r6]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r89 16r46]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r89 16r86]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRinTindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r89 16r1]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r89 16r41]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r89 16r81]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeShortTinRatOffsetA + self assembleBytes: #[16r66 16r89 16rC 16r10]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeSinRindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r89 16r30]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r89 16r70]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r89 16rB0]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTIBatRwithA + self assembleBytes: #[16r65 16r48 16r89 16r14 16rC5 16r0 16r0 16r0 16r0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTinRatA + self assembleBytes: #[16r48 16r89 16r4C 16rD0 16rF8]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTinRatOffsetA + self assembleBytes: #[16r48 16r89 16rC 16r10]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeTinRindex: index + | offset | + offset := index - 1 * wordSize. + offset = 0 ifTrue: [^self assembleBytes: #[16r48 16r89 16r8]]. + (-128 <= offset and: [offset < 128]) + ifTrue: [ + self + assembleBytes: #[16r48 16r89 16r48]; + assembleByte: offset] + ifFalse: [ + self + assembleBytes: #[16r48 16r89 16r88]; + assembleBytes: offset count: 4] +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subAfromR + self assembleBytes: #[16r48 16r29 16rD0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subAfromT + self assembleBytes: #[16r48 16r29 16rD1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subDoubleX1fromX0 + self assembleBytes: #[16rF2 16rF 16r5C 16rC1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:40'! +subTslotsToSP + self assembleBytes: #[16r48 16rF7 16rD9 16r48 16r8D 16r24 16rCC 16r48 16rF7 16rD9]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +platform: aNativizationPlatform + super platform: aNativizationPlatform. + wordSize := aNativizationPlatform wordSize. + buffer := RelocatableBuffer new. + +! ! + +!AMD64TemplateAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026 13:27:40'! +testRintegerBit + self assembleBytes: #[16rA8 16r1]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +testRwithR + self assembleBytes: #[16r48 16r85 16rC0]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'opcodes - integer related' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeTslots + self assembleBytes: #[16rF3 16r48 16rAB]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +xorAwithR + self assembleBytes: #[16r48 16r31 16rC2]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +xorFPwithFP + self assembleBytes: #[16r48 16r31 16rED]. + +! ! + +!AMD64TemplateAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026 13:27:40'! +xorRwithA + self assembleBytes: #[16r48 16r31 16rD0]. + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'AMD64TemplateAssembler class' category: #'Powerlang-Core-Assembler-Intel'! +AMD64TemplateAssembler class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/ISAImmediate.Class.st b/modules/LMR/Nativizer/Assembly/Intel/ISAImmediate.Class.st new file mode 100644 index 00000000..7f91f4fb --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/ISAImmediate.Class.st @@ -0,0 +1,116 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ISAImmediate category: #'Powerlang-Core-Assembler-Intel'! +ISAOperand subclass: #ISAImmediate + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!ISAImmediate commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ISAImmediate methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! += operand + self class == operand class ifFalse: [^false]. + value = operand value ifFalse: [^false]. + ^length = operand length +! ! + +!ISAImmediate methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +bytes + | bytes v | + bytes := ByteArray new: length // 8. + v := value. + v < 0 ifTrue: [v := v + (1 bitShift: length)]. + 1 to: bytes size do: [:i | + bytes at: i put: (v bitAnd: 16rFF). + v := v bitShift: -8]. + ^bytes +! ! + +!ISAImmediate methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +defaultLength + value < -168000000000000000 ifTrue: [^128]. + value < -16r80000000 ifTrue: [^64]. + value < -16r8000 ifTrue: [^32]. + value < -16r80 ifTrue: [^16]. + value < 16r80 ifTrue: [^8]. + value < 16r8000 ifTrue: [^16]. + value < 16r80000000 ifTrue: [^32]. + value < 16r8000000000000000 ifTrue: [^64]. + ^128 +! ! + +!ISAImmediate methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hash + ^value hashWith: length +! ! + +!ISAImmediate methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCompatibleWith: anOperandType + (value = 0 and: [anOperandType name = '0']) ifTrue: [^true]. + (value = 1 and: [anOperandType name = '1']) ifTrue: [^true]. + (value = 3 and: [anOperandType name = '3']) ifTrue: [^true]. + ^anOperandType isImmediate + and: [anOperandType hasImmediateFlag] + and: [length <= anOperandType length] +! ! + +!ISAImmediate methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isImmediate + ^true +! ! + +!ISAImmediate methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +looksLikeAddress + ^value > 65536 and: [value even] +! ! + +!ISAImmediate methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +memoryLength + ^nil +! ! + +!ISAImmediate methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefers: anOperandType to: otherOperandType + anOperandType length < otherOperandType length ifTrue: [^true]. + (value = 0 and: [anOperandType name = '0']) ifTrue: [^true]. + (value = 1 and: [anOperandType name = '1']) ifTrue: [^true]. + (value = 3 and: [anOperandType name = '3']) ifTrue: [^true]. + ^false +! ! + +!ISAImmediate methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + | v | + v := value isNil ifTrue: ['???'] ifFalse: [value hex]. + aStream nextPutAll: v +! ! + +!ISAImmediate methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +template + (0 <= value and: [value < 4]) ifTrue: [^self copy]. + ^self class new value: length; length: length +! ! + +!ISAImmediate methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^value +! ! + +!ISAImmediate methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: anInteger + value := anInteger. + length := self defaultLength +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ISAImmediate class' category: #'Powerlang-Core-Assembler-Intel'! +ISAImmediate class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/ISAInstruction.Class.st b/modules/LMR/Nativizer/Assembly/Intel/ISAInstruction.Class.st new file mode 100644 index 00000000..a5fbdaa8 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/ISAInstruction.Class.st @@ -0,0 +1,325 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ISAInstruction category: #'Powerlang-Core-Assembler-Intel'! +Object subclass: #ISAInstruction + instanceVariableNames: 'prefix mnemonic operands template' + classVariableNames: '' + poolDictionaries: 'Registers' + category: 'Powerlang-Core-Assembler-Intel'! +!ISAInstruction commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ISAInstruction methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! += instruction + self class == instruction class ifFalse: [^false]. + prefix = instruction prefix ifFalse: [^false]. + mnemonic = instruction mnemonic ifFalse: [^false]. + (self hasOperands or: [instruction hasOperands]) ifFalse: [^true]. + operands isNil ifTrue: [^false]. + operands size = instruction arity ifFalse: [^false]. + operands + with: instruction operands + do: [:op1 :op2 | op1 = op2 ifFalse: [^false]]. + ^true +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arity + ^operands size +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beTemplate + 1 to: operands size do: [:i | | op | + op := operands at: i. + operands at: i put: op template] +! ! + +!ISAInstruction methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +db: byte + | imm | + mnemonic := '.db'. + imm := ISAImmediate new value: byte. + operands := {imm} +! ! + +!ISAInstruction methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +encoder + ^InstructionEncoder new instruction: self +! ! + +!ISAInstruction methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +encoding32 + | s | + + s := ReadWriteStream on: ByteArray new. + self writeEncoding32On: s. + ^ s contents. + +! ! + +!ISAInstruction methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +encoding64 + | s | + + s := ReadWriteStream on: ByteArray new. + self writeEncoding64On: s. + ^ s contents. + +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasDirectMemoryReference + ^operands anySatisfy: [:op | op isDirectMemoryReference] +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasDisplacement + operands isNil ifTrue: [^false]. + ^operands anySatisfy: [:op | op isMemory and: [op hasDisplacement]] +! ! + +!ISAInstruction methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasOperands + ^operands notNil and: [operands size > 0] +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasSib + operands isNil ifTrue: [^false]. + ^operands anySatisfy: [:op | op isMemory and: [op hasSib]] +! ! + +!ISAInstruction methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hash + ^prefix hashWith: mnemonic with: self operand1 with: self operand2 +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCall + ^mnemonic = 'call' +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isJump + ^mnemonic first = $j or: [mnemonic beginsWith: 'loop'] +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLike: anISAInstruction + self class = anISAInstruction class ifFalse: [^false]. + mnemonic = anISAInstruction mnemonic ifTrue: [^self = anISAInstruction]. + operands = anISAInstruction operands ifFalse: [^false]. + ^self spec isLike: anISAInstruction spec +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isPushFP + | operand | + ^(mnemonic beginsWith: 'push') + and: [ + operand := operands at: 1. + operand isRegister] + and: [operand index = rbp index] +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isReturn + ^mnemonic = 'ret' +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isTemplate + 1 + to: operands size + do: [:i | (operands at: i) isTemplate ifFalse: [^false]]. + ^true +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isTestAL1 + mnemonic = 'test' ifFalse: [^false]. + operands first = al ifFalse: [^false]. + operands second isImmediate ifFalse: [^false]. + ^operands second value = 1 +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpOffset32 + self ASSERT: + ((self isJump or: [ self isCall ]) and: [ + operands anyone isImmediate ]). + ^ operands first value + self sizeInBytes32 +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +jumpOffset64 + self ASSERT: + ((self isJump or: [ self isCall ]) and: [ + operands anyone isImmediate ]). + ^ operands first value + self sizeInBytes64 +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mnemonic + ^mnemonic +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mnemonic: aString + mnemonic := aString asLowercase. + template notNil ifTrue: [template mnemonic: aString] +! ! + +!ISAInstruction methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +mod + (operands conform: [:op | op isRegister or: [op isImmediate]]) + ifTrue: [^2r11]. + operands do: [:op | op isMemory ifTrue: [^op mod]] +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand1 + ^operands notNil ifTrue: [operands at: 1 ifAbsent: nil] +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand2 + ^operands notNil ifTrue: [operands at: 2 ifAbsent: nil] +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand3 + ^operands at: 3 +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand4 + ^operands at: 4 +! ! + +!ISAInstruction methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +operandFrom: anObject + anObject isInteger ifTrue: [^ISAImmediate new value: anObject]. + anObject isString ifTrue: [ + ^anObject first = $@ + ifTrue: [anObject] + ifFalse: [MemoryOperand fromString: anObject]]. + ^anObject +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands + ^operands ifNil: #() +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands: aCollection + operands := aCollection collect: [:op | self operandFrom: op]. + template notNil + ifTrue: [template operands: (operands collect: [:op | op template])] +! ! + +!ISAInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +overridesAddressSize: anInteger + | length | + operands isNil ifTrue: [^false]. + length := anInteger bitShift: 3. + ^operands + anySatisfy: [:op | op isMemory + and: [op base notNil] + and: [op pointerLength !!= length]] +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefix + ^prefix +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefix: aLegacyPrefix + prefix := aLegacyPrefix. + template notNil ifTrue: [template prefix: aLegacyPrefix] +! ! + +!ISAInstruction methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + aStream nextPutAll: mnemonic. + operands isNil ifTrue: [^self]. + operands + do: [:op | aStream space; nextPutAll: op asString] + separatedBy: [aStream nextPut: $,] +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sizeInBytes32 + | stream | + stream := #[ ] writeStream. + self writeEncoding32On: stream. + ^ stream size +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sizeInBytes64 + | stream | + stream := #[ ] writeStream. + self writeEncoding64On: stream. + ^ stream size +! ! + +!ISAInstruction methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +spec + ^self encoder spec +! ! + +!ISAInstruction methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +template + ^template +! ! + +!ISAInstruction methodsFor: 'updating' stamp: 'KenD 28/Jun/2026 13:27:40'! +updateTemplate: anISAInstruction + | arity array | + arity := operands size. + array := Array new: arity. + 1 to: arity do: [:i | array at: i put: (operands at: i) template]. + anISAInstruction + prefix: prefix; + mnemonic: mnemonic; + operands: array +! ! + +!ISAInstruction methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +useTemplate + template := self shallowCopy. + mnemonic isNil ifTrue: [^self]. + template mnemonic: mnemonic; prefix: prefix. + operands notNil + ifTrue: [template operands: (operands collect: [:op | op template])] +! ! + +!ISAInstruction methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeEncoding32On: aStream + ^self encoder wordSize: 4; writeEncodingOn: aStream +! ! + +!ISAInstruction methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeEncoding64On: aStream + ^self encoder wordSize: 8; writeEncodingOn: aStream +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ISAInstruction class' category: #'Powerlang-Core-Assembler-Intel'! +ISAInstruction class + instanceVariableNames: ''! + +!ISAInstruction class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +db: byte + ^self new db: byte +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/ISAOperand.Class.st b/modules/LMR/Nativizer/Assembly/Intel/ISAOperand.Class.st new file mode 100644 index 00000000..c115e131 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/ISAOperand.Class.st @@ -0,0 +1,130 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ISAOperand category: #'Powerlang-Core-Assembler-Intel'! +Object subclass: #ISAOperand + instanceVariableNames: 'length' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!ISAOperand commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +, anISAOperand + ^{self. anISAOperand} +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +baseExtension + ^0 +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +indexExtension + ^0 +! ! + +!ISAOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDirectMemoryReference + ^false +! ! + +!ISAOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isImmediate + ^false +! ! + +!ISAOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isMemory + ^false +! ! + +!ISAOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isRegister + ^false +! ! + +!ISAOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isTemplate + ^false +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +length + ^length +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +length: anInteger + length := anInteger +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +memoryLength + ^length +! ! + +!ISAOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +needsExtraBit + ^false +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +offsetOfIndex: index + length = 64 ifTrue: [^index - 1 bitShift: 3]. + length = 32 ifTrue: [^index - 1 bitShift: 2]. + length = 8 ifTrue: [^index - 1]. + self error: 'invalid operand' +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand1 + ^self +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand2 + ^self +! ! + +!ISAOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefers: anOperandType to: anotherOperandType + ^false +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +regExtension + ^0 +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sizeInBits + ^self length + +! ! + +!ISAOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sizeInBytes + ^length // 8 +! ! + +!ISAOperand methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +template + ^self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ISAOperand class' category: #'Powerlang-Core-Assembler-Intel'! +ISAOperand class + instanceVariableNames: ''! + +!ISAOperand class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +new + ^super new initialize +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/ISAOperandType.Class.st b/modules/LMR/Nativizer/Assembly/Intel/ISAOperandType.Class.st new file mode 100644 index 00000000..20ffa82b --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/ISAOperandType.Class.st @@ -0,0 +1,474 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ISAOperandType category: #'Powerlang-Core-Assembler-Intel'! +Object subclass: #ISAOperandType + instanceVariableNames: 'type length memoryLength flags' + classVariableNames: 'Types' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!ISAOperandType commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ISAOperandType methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addFlag: flagBit + flags := flags bitOr: flagBit +! ! + +!ISAOperandType methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +constant + | i | + i := #('0' '1' '3') indexOf: type. + ^i > 0 ifTrue: [#[0 1 3] at: i] +! ! + +!ISAOperandType methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +getMemoryLength + (type includesString: '/m8') ifTrue: [^8]. + (type includesString: '/m16') ifTrue: [^16]. + (type includesString: '/m32') ifTrue: [^32]. + (type includesString: '/m64') ifTrue: [^64]. + (type includesString: '/m128') ifTrue: [^128]. + (type includesString: ':16') ifTrue: [^0]. + (type includesString: ':32') ifTrue: [^0]. + (type includesString: ':64') ifTrue: [^0]. + ^length +! ! + +!ISAOperandType methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasFlag: flagBit + ^flags isOnBit: flagBit +! ! + +!ISAOperandType methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasImmediateFlag + ^self hasFlag: ImmediateType +! ! + +!ISAOperandType methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeConstantFlag + type anyone isDigit ifTrue: [self addFlag: ConstantType] + +! ! + +!ISAOperandType methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeImmediateFlag + ((type includesString: 'imm') or: [type includesString: 'rel']) + ifTrue: [self addFlag: ImmediateType] +! ! + +!ISAOperandType methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeMemoryFlag + self isImmediate ifTrue: [^self]. + (#('m8' 'm16' 'm32' 'm64' 'm128' 'm256' 'm512') + anySatisfy: [:s | type includesString: s]) + ifTrue: [^self addFlag: MemoryType]. + ((type includes: $m) + and: [(type includesString: 'mm') not] + and: [(type includesString: 'vm') not] + and: [(type includesString: 'offs') not]) + ifTrue: [self addFlag: MemoryType] +! ! + +!ISAOperandType methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeMemoryLength + memoryLength := self getMemoryLength +! ! + +!ISAOperandType methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeRegisterFlag + self isImmediate ifTrue: [^self]. + (type includesString: 'r/m') ifTrue: [^self addFlag: RegisterType]. + (#('r8' 'r16' 'r32' 'r64' 'reg') anySatisfy: [:s | type includesString: s]) + ifTrue: [^self addFlag: RegisterType]. + (type includesString: 'mm') ifTrue: [^self addFlag: RegisterType]. + (self specificRegisterNames includes: type) + ifTrue: [self addFlag: RegisterType] +! ! + +!ISAOperandType methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeRegisterGroupFlag + self isImmediate ifTrue: [^self]. + (type includesString: 'r/m') ifTrue: [^self addFlag: RegisterGP]. + (#('r8' 'r16' 'r32' 'r64' 'reg') anySatisfy: [:s | type includesString: s]) + ifTrue: [^self addFlag: RegisterGP]. + (type includesString: 'mm') ifTrue: [^self addFlag: RegisterSIMD]. + (self specificRegisterNames includes: type) + ifTrue: [^self addFlag: RegisterSpecific]. + type = 'sreg' ifTrue: [^self addFlag: RegisterSegment] +! ! + +!ISAOperandType methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeSegmentFlag + ^type = 'sreg' ifTrue: [self addFlag: RegisterSegment] +! ! + +!ISAOperandType methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isConstant + ^self hasFlag: ConstantType +! ! + +!ISAOperandType methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isImmediate + ^self hasFlag: ImmediateType +! ! + +!ISAOperandType methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isMemory + ^self hasFlag: MemoryType +! ! + +!ISAOperandType methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isMoff + ^type beginsWith: 'moff' +! ! + +!ISAOperandType methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isRegister + ^self hasFlag: RegisterType +! ! + +!ISAOperandType methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSegment + ^self hasFlag: RegisterSegment +! ! + +!ISAOperandType methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSpecificRegister + ^self registerGroup = RegisterSpecific +! ! + +!ISAOperandType methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +length + ^length +! ! + +!ISAOperandType methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +length: aString + length := aString = '?' ifFalse: [aString asInteger] +! ! + +!ISAOperandType methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +lengthForBits: n + ^(type beginsWith: 'moff') ifTrue: [n] ifFalse: [length] +! ! + +!ISAOperandType methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +memoryLength + ^memoryLength +! ! + +!ISAOperandType methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^type +! ! + +!ISAOperandType methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +normalized + type first = $r ifFalse: [^self]. + type = 'rel8' ifTrue: [^self class imm8]. + type = 'rel16' ifTrue: [^self class imm16]. + type = 'rel32' ifTrue: [^self class imm32]. + type = 'r32a' ifTrue: [^self class r32]. + type = 'r32b' ifTrue: [^self class r32]. + type = 'r64a' ifTrue: [^self class r64]. + type = 'r64b' ifTrue: [^self class r64] +! ! + +!ISAOperandType methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +operandFrom: anInteger + self ASSERT: self isMoff. + ^MemoryOperand new displacement: anInteger; length: memoryLength +! ! + +!ISAOperandType methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + aStream nextPutAll: type +! ! + +!ISAOperandType methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +register + type = '' ifTrue: [^xmm0]. + type = 'r8' ifTrue: [^nil]. + ^Register named: type +! ! + +!ISAOperandType methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +registerGroup + ^flags bitAnd: RegisterGroupMask +! ! + +!ISAOperandType methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +specificRegisterNames + ^#('rax' 'eax' 'ax' 'al' 'cl' 'dx' 'es' 'cs' 'ss' 'ds' 'fs' 'gs') +! ! + +!ISAOperandType methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +type: aString + type := aString. + flags := 0. + self + initializeMemoryLength; + initializeConstantFlag; + initializeImmediateFlag; + initializeMemoryFlag; + initializeRegisterFlag; + initializeSegmentFlag; + initializeRegisterGroupFlag +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ISAOperandType class' category: #'Powerlang-Core-Assembler-Intel'! +ISAOperandType class + instanceVariableNames: 'Types'! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +imm16 + ^self named: 'imm16' +! ! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +imm32 + ^self named: 'imm32' +! ! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +imm8 + ^self named: 'imm8' +! ! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +immediateTypes + ^Types select: [:t | t isImmediate] +! ! + +!ISAOperandType class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeOperandTypeFlags + self addNamespaceAs: #OperandTypeFlags. + OperandTypeFlags + at: #MemoryType put: 4; + at: #RegisterGroupMask put: 3840; + at: #ConstantType put: 2; + at: #RegisterSIMD put: 256; + at: #ImmediateType put: 1; + at: #RegisterGP put: 0; + at: #RegisterType put: 8; + at: #RegisterSegment put: 512; + at: #RegisterSpecific put: 768. +! ! + +!ISAOperandType class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeTypes + | dictionary | + dictionary := Dictionary new. + self typeNames lines collect: [:s | | pair type | + pair := s substrings. + type := self new type: pair first; length: pair second. + dictionary at: type name put: type]. + Types := dictionary +! ! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +memoryTypes + ^Types select: [:t | t isMemory] in: OrderedCollection new +! ! + +!ISAOperandType class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +named: aString + ^Types at: aString +! ! + +!ISAOperandType class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +operandTypeFlags + ^OperandTypeFlags +! ! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +r32 + ^self named: 'r32' +! ! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +r64 + ^self named: 'r64' +! ! + +!ISAOperandType class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +typeNames + ^' 128 + 0 8 + 1 8 + 3 0 + al 8 + dx 16 + ax 16 + cl 8 + cr0-cr7 ? + cr8 ? + cs 16 + dr0-dr7 ? + ds 16 + dx 16 + eax 32 + dx 16 + es 16 + far 0 + fs 16 + gs 16 + imm16 16 + imm32 32 + imm64 64 + imm8 8 + m ? + m108byte ? + m128 128 + m16 16 + m16&16 16 + m16&32 ? + m16&64 ? + m16:16 16 + m16:32 48 + m16:64 80 + m16int 16 + m256 256 + m28byte 7 + m2byte 16 + m32 32 + m32&32 32 + m32fp 32 + m32int 32 + m512byte 512 + m64 64 + m64fp 64 + m64int 64 + m8 8 + m80bcd 80 + m80fp 80 + mem ? + mm 64 + mm1 64 + mm2 64 + mm/m32 64 + mm/m64 64 + mm2/m64 64 + moffs16 16 + moffs32 32 + moffs64 64 + moffs8 8 + p66 0 + ptr16:16 16 + ptr16:32 16 + pw 0 + r/m16 16 + r/m32 32 + r/m64 64 + r/m8 8 + r/m8 8 + r8 8 + r16 16 + r16/m16 16 + r32 32 + r32/m16 32 + r32/m32 32 + r32/m8 32 + r32a 32 + r32b 32 + r64 64 + r64/m16 64 + r64/m64 64 + r64a 64 + r64b 64 + rax 64 + reg ? + reg/m16 16 + reg/m32 32 + reg/m8 8 + rel16 16 + rel32 32 + rel8 8 + sreg 16 + ss 16 + st ? + st(0) ? + st(i) ? + vm32x 32 + vm32y 32 + vm64x 64 + vm64y 64 + xmm 128 + xmm/m128 128 + xmm/m32 128 + xmm/m64 128 + xmm0 128 + xmm1 128 + xmm1/m128 128 + xmm1/m32 128 + xmm1/m64 128 + xmm2 128 + xmm2/m128 128 + xmm2/m16 128 + xmm2/m32 128 + xmm2/m64 128 + xmm2/m8 128 + xmm3 128 + xmm3/m128 128 + xmm3/m32 128 + xmm3/m64 128 + xmm4 128 + ymm0 256 + ymm1 256 + ymm2 256 + ymm2/m256 256 + ymm3/m256 256 + ymm4 256' +! ! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +typeOfSpecialRegister: aRegister + aRegister = rax ifTrue: [^self named: 'rax']. + aRegister = eax ifTrue: [^self named: 'eax']. + aRegister = ax ifTrue: [^self named: 'ax']. + aRegister = al ifTrue: [^self named: 'al']. + aRegister = cl ifTrue: [^self named: 'cl']. + aRegister = dx ifTrue: [^self named: 'dx'] +! ! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +typesOfGeneralRegister: aRegister + | bits associations | + bits := aRegister length asString. + associations := OrderedCollection new: 4. + Types do: [:type | | n | + n := type name. + n = ('r' , bits) ifTrue: [associations add: 1 -> type]. + n = 'reg' ifTrue: [associations add: 2 -> type]. + n = ('r/m' , bits) ifTrue: [associations add: 3 -> type]. + n = ('r' , bits , '/m' , bits) ifTrue: [associations add: 4 -> type]]. + ^(associations sortBy: #key) collect: #value +! ! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +typesOfSIMDRegister: aRegister + | s | + s := aRegister name. + ^Types select: [:type | | n | + (#('0' '1' '3') includes: type name) not + and: [ + n := type name upTo: $/. + n size >= 3] + and: [n first !!= $m] + and: [s includesString: n]] +! ! + +!ISAOperandType class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +typesOfSegmentRegister: aRegister + | type sreg | + type := self named: aRegister name. + sreg := self named: 'sreg'. + ^{type. sreg} +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/InstructionEncoder.Class.st b/modules/LMR/Nativizer/Assembly/Intel/InstructionEncoder.Class.st new file mode 100644 index 00000000..fbe0a2d0 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/InstructionEncoder.Class.st @@ -0,0 +1,603 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #InstructionEncoder category: #'Powerlang-Core-Assembler-Intel'! +Object subclass: #InstructionEncoder + instanceVariableNames: 'instruction spec stream prefixes rex vex opcode modrm sib displacement immediate immediate2 wordSize' + classVariableNames: 'Cache' + poolDictionaries: 'Registers' + category: 'Powerlang-Core-Assembler-Intel'! +!InstructionEncoder commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arity + ^spec arity +! ! + +!InstructionEncoder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: position + | pos | + pos := stream position. + ^[stream position: position; peek] ensure: [stream position: pos] +! ! + +!InstructionEncoder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +bestMatchingSpec + | template s | + template := instruction template. + s := Cache at: template ifAbsent: nil. + s notNil ifTrue: [^s]. + s := InstructionSpec + bestMatchForMnemonic: template mnemonic + operands: template operands + wordSize: wordSize. + Cache at: template copy put: s. + ^s +! ! + +!InstructionEncoder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +displacementOffset + ^displacement +! ! + +!InstructionEncoder methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasDisplacement + ^instruction hasDisplacement +! ! + +!InstructionEncoder methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasModRM + ^spec hasModRM +! ! + +!InstructionEncoder methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasRex + ^vex > rex +! ! + +!InstructionEncoder methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasSib + ^instruction hasSib +! ! + +!InstructionEncoder methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasVex + ^opcode > vex +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +immediate2: aByteArray + stream position: immediate2; nextPutAll: aByteArray +! ! + +!InstructionEncoder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +immediate2Offset + ^immediate2 +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +immediate: aByteArray + immediate isNil ifTrue: [ + immediate := stream position. + modrm isNil ifTrue: [modrm := sib := displacement := immediate]]. + stream position: immediate. + aByteArray isCollection + ifTrue: [stream nextPutAll: aByteArray] + ifFalse: [stream nextPut: aByteArray]. + immediate2 := stream position +! ! + +!InstructionEncoder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +immediateOffset + ^immediate +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +indexExtension + ^instruction operands maxValue: [:op | op indexExtension] +! ! + +!InstructionEncoder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + wordSize := 8 +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +instruction: anISAInstruction + instruction := anISAInstruction. + instruction useTemplate +! ! + +!InstructionEncoder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +legacyMap + ^String streamContents: [:strm | + (prefixes to: rex - 1) + do: [:i | | p | + p := self at: i. + strm nextPutAll: p hex] + separatedBy: [strm space]] +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +mmmmm: anInteger + | pos byte | + pos := stream position. + byte := stream position: vex + 1; peek. + byte := byte bitOr: anInteger. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +opcode: aByteArray + | pos | + pos := stream position. + stream + position: opcode; + nextPutAll: aByteArray; + position: pos +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand1 + ^instruction operand1 +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand2 + ^instruction operand2 +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand3 + ^instruction operand3 +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand4 + ^instruction operand4 +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands + ^instruction operands +! ! + +!InstructionEncoder methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +overridesOperandSize + | operands op | + operands := instruction operands. + operands size = 0 ifTrue: [^false]. + op := operands first. + (op isRegister and: [op isSegment]) ifTrue: [^false]. + op memoryLength = 16 ifTrue: [ + ^instruction mnemonic first = $f + ifTrue: [spec operands first length !!= 16] + ifFalse: [true]]. + operands with: spec operands do: [:a :f | + (a isImmediate not + and: [a memoryLength !!= f memoryLength] + and: [a memoryLength !!= f length] + and: [(a isMemory and: [f name = 'm']) not]) + ifTrue: [^true]]. + ^false +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +pp: anInteger + | pos offset byte | + pos := stream position. + offset := stream peek = 16rC5 ifTrue: [2] ifFalse: [1]. + byte := stream position: vex + offset; peek. + byte := byte bitOr: anInteger. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefixesMap + | parts | + parts := {self legacyMap. self rexMap. self vexMap}. + parts := parts select: #notEmpty. + ^String + streamContents: [:strm | parts do: [:p | strm nextPutAll: p; space]] +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +reg: aRegister + | index prev | + modrm isNil + ifTrue: [modrm := stream position] + ifFalse: [prev := stream position]. + stream position: modrm. + index := aRegister isInteger ifTrue: [aRegister] ifFalse: [aRegister index]. + self + writeMid: index; + rexR: index > 7. + sib := stream position. + (prev notNil and: [prev > sib]) ifTrue: [stream position: prev] +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +reset + spec := rex := modrm := sib := displacement := immediate := nil +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +rexB: aBoolean + | pos byte | + aBoolean ifFalse: [^self]. + pos := stream position. + byte := stream position: rex; peek. + byte := byte bitOr: REXPrefix b. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +rexB: aBoolean opcode: aByteArray + (rex isNil or: [rex = opcode]) ifTrue: [ + rex := opcode. + stream position: rex; nextPut: REXPrefix rex value. + opcode := opcode + 1]. + self rexB: aBoolean; opcode: aByteArray. + stream position: opcode; skip: aByteArray size +! ! + +!InstructionEncoder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +rexMap + ^String streamContents: [:strm | + (rex to: vex - 1) + do: [:i | | p | + p := self at: i. + REXPrefix print: p on: strm] + separatedBy: [strm space]] +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +rexR: aBoolean + | pos byte | + aBoolean ifFalse: [^self]. + pos := stream position. + byte := stream position: rex; peek. + byte := byte bitOr: REXPrefix r value. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +rexX + self hasSib ifFalse: [^0]. + instruction operands + select: [:op | op isMemory] + thenDo: [:op | ^op indexExtension] +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +rexX: aBoolean + | pos byte | + aBoolean ifFalse: [^self]. + pos := stream position. + byte := stream position: rex; peek. + byte := byte bitOr: REXPrefix x. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +rm: anInteger + modrm isNil ifTrue: [modrm := stream position]. + stream position: modrm. + self + writeLo: anInteger; + rexB: anInteger > 7. + sib := stream position. + self writeSib; writeDisplacement +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +spec + spec notNil ifTrue: [^spec]. + ^spec := self bestMatchingSpec +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +vexB: aBoolean + | pos byte | + (self at: vex) = 16rC5 ifTrue: [^self]. + aBoolean ifFalse: [^self]. + pos := stream position. + byte := stream position: vex + 1; peek. + byte := byte bitOr: VEXPrefix b. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +vexL: aBoolean + | pos offset byte | + aBoolean ifFalse: [^self]. + pos := stream position. + offset := stream peek = 16rC5 ifTrue: [2] ifFalse: [1]. + byte := stream position: vex + offset; peek. + byte := byte bitOr: VEXPrefix l. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +vexMap + ^String streamContents: [:strm | + (vex to: opcode - 1) + do: [:i | | p | + p := self at: i. + VEXPrefix print: p on: strm] + separatedBy: [strm space]] +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +vexR: aBoolean + | pos byte | + aBoolean ifFalse: [^self]. + pos := stream position. + byte := stream position: vex + 1; peek. + byte := byte bitOr: VEXPrefix r. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +vexW: aBoolean + | pos byte | + aBoolean ifFalse: [^self]. + pos := stream position. + byte := stream position: vex + 2; peek. + byte := byte bitOr: VEXPrefix w. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +vexX: aBoolean + | pos byte | + (self at: vex) = 16rC5 ifTrue: [^self]. + aBoolean ifFalse: [^self]. + pos := stream position. + byte := stream position: vex + 1; peek. + byte := byte bitOr: VEXPrefix x. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +vreg: aRegister + | index | + modrm isNil ifTrue: [modrm := stream position]. + stream position: modrm. + index := aRegister isInteger ifTrue: [aRegister] ifFalse: [aRegister index]. + self + writeMid: index; + vexR: index < 8. + sib := stream position +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +vrm: anInteger + modrm isNil ifTrue: [modrm := stream position]. + stream position: modrm. + self + writeLo: anInteger; + vexB: anInteger < 8; + vexX: self rexX = 0. + sib := stream position. + self writeSib; writeDisplacement +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +vvvv: anInteger + | pos offset byte vvvv | + pos := stream position. + stream position: vex. + offset := stream peek = 16rC5 ifTrue: [1] ifFalse: [2]. + byte := stream position: vex + offset; peek. + vvvv := (anInteger bitInvert bitShift: 3) bitAnd: 2r1111000. + byte := (byte bitAnd: 2r10000111) bitOr: vvvv. + byte < 0 ifTrue: [byte := 256 + byte]. + stream nextPut: byte; position: pos +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSize + ^wordSize +! ! + +!InstructionEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSize: anInteger + self ASSERT: (anInteger = 4 or: [anInteger = 8]). + wordSize := anInteger +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeDisplacement + self hasDisplacement ifTrue: [ + instruction operands + select: [:op | op isMemory] + thenDo: [:op | stream nextPutAll: op displacementBytes]]. + immediate isNil ifTrue: [immediate := stream position] +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeEncodingOn: aStream + stream := aStream. + prefixes := rex := vex := stream position. + self writePrefixes; writeOpcode; writeOperands +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeExtension: anInteger + | pos bit4 | + pos := stream position. + stream position: modrm. + self writeMid: anInteger. + (self hasRex and: [bit4 := anInteger > 7]) ifTrue: [self rexR: bit4]. + (self hasVex and: [bit4 := anInteger < 8]) ifTrue: [self vexR: bit4]. + sib := stream position. + stream position: pos +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeHi: anInteger + | bits byte | + bits := (anInteger bitAnd: 8r3) bitShift: 6. + byte := stream peek ifNil: 0. + byte := (byte bitAnd: 8r77) bitOr: bits. + stream nextPut: byte +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeLegacyPrefix: byte + stream nextPut: byte. + rex := vex := stream position +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeLo: anInteger + | byte modReg rm | + byte := stream peek ifNil: 0. + modReg := byte bitAnd: 8r370. + rm := anInteger bitAnd: 8r7. + byte := modReg bitOr: rm. + stream nextPut: byte +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeMid: anInteger + | bits byte | + bits := (anInteger bitAnd: 8r7) bitShift: 3. + byte := stream peek ifNil: 0. + byte := (byte bitAnd: 8r307) bitOr: bits. + stream nextPut: byte +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeMod + | pos | + pos := stream position. + stream position: modrm. + self writeHi: instruction mod. + stream position: pos +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeOpcode + stream position: opcode; nextPutAll: spec primaryOpcode. + modrm := stream position. + spec extension ifNotNil: [:e | self writeExtension: e] +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeOperands + spec operandEncoding ifNotNil: [:oe | + oe encodeOperands: self. + self hasModRM ifTrue: [self writeMod]] +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writePrefixes + | head p67 p66 | + self writeSegmentPrefixes. + instruction prefix notNil ifTrue: [instruction prefix writeOn: self]. + head := self spec prefixes asOrderedCollection. + p66 := LegacyPrefix operandSizeOverride. + p67 := LegacyPrefix addressSizeOverride. + (head anySatisfy: [:p | p = p66 or: [p = p67] or: [p isVex]]) ifFalse: [ + self overridesOperandSize ifTrue: [head addFirst: p66]. + (instruction overridesAddressSize: wordSize) ifTrue: [head addFirst: p67]]. + head do: [:prefix | prefix writeOn: self]. + ((head noneSatisfy: [:p | p isRex or: [p isVex]]) and: [ + (instruction operands anySatisfy: [:op | op needsExtraBit]) or: [ + instruction operands + anySatisfy: [:op | op = spl or: [op = bpl] or: [op = sil] or: [op = dil]]]]) + ifTrue: [REXPrefix rex writeOn: self]. + opcode := stream position +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeRexPrefix: byte + self ASSERT: wordSize = 8. + stream nextPut: byte. + vex := stream position +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeSegmentPrefixes + instruction operands + select: [:op | op isMemory andNot: [op segment isNil]] + thenDo: [:op | | seg | + seg := op segment. + seg = cs ifTrue: [self writeLegacyPrefix: 16r2E]. + seg = ss ifTrue: [self writeLegacyPrefix: 16r36]. + seg = ds ifTrue: [self writeLegacyPrefix: 16r3E]. + seg = es ifTrue: [self writeLegacyPrefix: 16r26]. + seg = fs ifTrue: [self writeLegacyPrefix: 16r64]. + seg = gs ifTrue: [self writeLegacyPrefix: 16r65]] +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeSib + | operand | + self hasSib ifTrue: [ + operand := instruction operands detect: [:op | op isMemory]. + stream nextPut: operand sib. + opcode - vex > 0 + ifTrue: [ + self + vexX: operand indexExtension = 0; + vexB: operand baseExtension = 0] + ifFalse: [ + self + rexX: operand indexExtension > 0; + rexB: operand baseExtension > 0]]. + displacement := stream position +! ! + +!InstructionEncoder methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeVexPrefix: aByteArray + vex := stream position. + stream nextPutAll: aByteArray +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InstructionEncoder class' category: #'Powerlang-Core-Assembler-Intel'! +InstructionEncoder class + instanceVariableNames: 'Cache'! + +!InstructionEncoder class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +checkCache64 + Cache keysAndValuesDo: [:k :v | | s | + s := InstructionSpec + bestMatchForMnemonic: k mnemonic + operands: k operands + wordSize: 8. + self ASSERT: s = v] +! ! + +!InstructionEncoder class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + self initializeCache + +! ! + +!InstructionEncoder class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeCache + Cache := Dictionary new +! ! + +!InstructionEncoder class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +invalidateCache + Cache removeAll +! ! + +!InstructionEncoder class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +new + ^super new initialize +! ! + + +InstructionEncoder initialize! + diff --git a/modules/LMR/Nativizer/Assembly/Intel/InstructionPrefix.Class.st b/modules/LMR/Nativizer/Assembly/Intel/InstructionPrefix.Class.st new file mode 100644 index 00000000..390d0888 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/InstructionPrefix.Class.st @@ -0,0 +1,119 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #InstructionPrefix category: #'Powerlang-Core-Assembler-Intel'! +Object subclass: #InstructionPrefix + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!InstructionPrefix commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!InstructionPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLegacy + ^false +! ! + +!InstructionPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isRex + ^false +! ! + +!InstructionPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSegment + ^false +! ! + +!InstructionPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isVex + ^false +! ! + +!InstructionPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^name +! ! + +!InstructionPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name: aString + name := aString +! ! + +!InstructionPrefix methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + (name includes: Character space) + ifTrue: [ + aStream + nextPut: ${; + nextPutAll: name; + nextPut: $}] + ifFalse: [aStream nextPutAll: name] +! ! + +!InstructionPrefix methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeOn: anInstruction + self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InstructionPrefix class' category: #'Powerlang-Core-Assembler-Intel'! +InstructionPrefix class + instanceVariableNames: ''! + +!InstructionPrefix class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +classFor: aString + (aString beginsWith: 'REX') ifTrue: [^REXPrefix]. + (aString beginsWith: 'VEX') ifTrue: [^VEXPrefix]. + ^LegacyPrefix +! ! + +!InstructionPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +fromString: aString + | reader prefixes rex | + reader := aString readStream. + prefixes := Prefixes + select: [:p | reader peekForAll: p value hex] + in: OrderedCollection new. + (reader peek: 'REX' size) = 'REX' ifTrue: [ + rex := REXPrefix fromStream: reader. + prefixes add: rex]. + (reader peek: 'VEX' size) = 'VEX' ifTrue: [ + rex := VEXPrefix fromStream: reader. + prefixes add: rex]. + ^prefixes +! ! + +!InstructionPrefix class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializePrefixes + self addNamespaceAs: #Prefixes. + LegacyPrefix initializePrefixes. + REXPrefix initializePrefixes +! ! + +!InstructionPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +named: aString + ^self new name: aString +! ! + +!InstructionPrefix class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +peekFrom: aStream + (aStream peekFor: LOCK value) ifTrue: [^LOCK]. + (aStream peekFor: REPNE value) ifTrue: [^REPNE]. + (aStream peekFor: REP value) ifTrue: [^REP]. + (aStream peekFor: OperandSize_Override value) + ifTrue: [^OperandSize_Override]. + (aStream peekFor: AddressSize_Override value) + ifTrue: [^AddressSize_Override]. + ^nil +! ! + +!InstructionPrefix class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefixes + ^Prefixes +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/InstructionSpec.Class.st b/modules/LMR/Nativizer/Assembly/Intel/InstructionSpec.Class.st new file mode 100644 index 00000000..9976c715 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/InstructionSpec.Class.st @@ -0,0 +1,3258 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #InstructionSpec category: #'Powerlang-Core-Assembler-Intel'! +Object subclass: #InstructionSpec + instanceVariableNames: 'opcode primary extension instruction opEncoding properties implicitRead implicitWrite implicitUndef useful protected mode compat features atnt preferred description prefixes mnemonic operands' + classVariableNames: 'Specs' + poolDictionaries: 'CharacterConstants' + category: 'Powerlang-Core-Assembler-Intel'! +!InstructionSpec commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!InstructionSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptsOperands: aCollection + operands size = aCollection size ifFalse: [^false]. + aCollection + with: operands + do: [:real :spec | (real isCompatibleWith: spec) ifFalse: [^false]]. + ^true +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arity + ^operands size +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +atnt + ^atnt +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compat + ^compat +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +description + ^description +! ! + +!InstructionSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodingSelectors + opEncoding isNil ifTrue: [^#()]. + ^opEncoding selectors +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +existsInWordSize: wordSize + ^wordSize = 8 ifTrue: [mode first = $V] ifFalse: [compat first = $V] +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +extension + ^extension +! ! + +!InstructionSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +family + ^Specs at: mnemonic +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +features + ^features +! ! + +!InstructionSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +fixDocumentation + (mnemonic = 'enter' and: [operands second length = 16]) + ifTrue: [operands swap: 1 with: 2]. + (mnemonic = 'pushq' and: [operands first length !!= 16]) + ifTrue: [mnemonic := 'push']. + (instruction = 'vmovsd xmm1, xmm2, xmm3' and: [primary = #[16r11]]) ifTrue: [ + operands swap: 1 with: 3. + instruction := 'vmovsd xmm3, xmm2, xmm1'] +! ! + +!InstructionSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +fixOpcode: oc + ^oc = '0f' ifTrue: ['0F'] ifFalse: [oc] +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +fromString: aString + | fields | + fields := Tab split: aString. + self + instruction: fields second; + opcode: fields first; + operandEncoding: fields third trimBlanks. + properties := fields at: 4. + implicitRead := fields at: 5. + implicitWrite := fields at: 6. + implicitUndef := fields at: 7. + useful := fields at: 8. + protected := (fields at: 9) = 'YES'. + mode := fields at: 10. + compat := fields at: 11. + features := fields at: 12. + atnt := fields at: 13. + preferred := (fields at: 14) = 'YES'. + description := fields at: 15. + self fixDocumentation +! ! + +!InstructionSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasImmediate2Data + ^opEncoding usesImmediate2 +! ! + +!InstructionSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasImmediateData + ^opEncoding usesImmediate +! ! + +!InstructionSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasModRM + | arity | + extension notNil ifTrue: [^true]. + arity := self arity. + arity = 0 ifTrue: [^false]. + (arity = 1 and: [operands first isConstant]) ifTrue: [^false]. + ^opEncoding usesModRM +! ! + +!InstructionSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasOperandEncoding: anOperandEncoding + opEncoding = anOperandEncoding ifTrue: [^true]. + (opEncoding isNil and: [anOperandEncoding name = 'NP']) ifTrue: [^true]. + ^opEncoding name = 'NP' and: [anOperandEncoding isNil] +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +implicitRead + ^implicitRead +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +implicitUndef + ^implicitUndef +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +implicitWrite + ^implicitWrite +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +instruction + ^instruction +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +instruction: aString + | substrings | + instruction := aString asLowercase. + substrings := (instruction replaceAllSubstrings: ',' with: ' ') substrings. + mnemonic := substrings first. + self operandsFrom: substrings +! ! + +!InstructionSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLike: anInstructionSpec + opcode = anInstructionSpec opcode ifFalse: [^false]. + primary = anInstructionSpec primaryOpcode ifFalse: [^false]. + extension = anInstructionSpec extension ifFalse: [^false]. + (self hasOperandEncoding: anInstructionSpec operandEncoding) + ifFalse: [^false]. + properties = anInstructionSpec properties ifFalse: [^false]. + implicitRead = anInstructionSpec implicitRead ifFalse: [^false]. + implicitWrite = anInstructionSpec implicitWrite ifFalse: [^false]. + implicitUndef = anInstructionSpec implicitUndef ifFalse: [^false]. + useful = anInstructionSpec useful ifFalse: [^false]. + protected = anInstructionSpec protected ifFalse: [^false]. + mode = anInstructionSpec mode ifFalse: [^false]. + compat = anInstructionSpec compat ifFalse: [^false]. + features = anInstructionSpec features ifFalse: [^false]. + preferred = anInstructionSpec isPreferred ifFalse: [^false]. + prefixes = anInstructionSpec prefixes ifFalse: [^false]. + ^operands = anInstructionSpec operands +! ! + +!InstructionSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isPreferred + ^preferred +! ! + +!InstructionSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isPreferredTo: otherSpec for: realOperands + 1 to: operands size do: [:i | | real this other | + real := realOperands at: i. + this := operands at: i. + other := otherSpec operands at: i. + (real prefers: this to: other) ifTrue: [^true]]. + ^false +! ! + +!InstructionSpec methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +legacyPrefixesFrom: aStream + | prefix | + aStream peekForAll: 'PREF.'. + [| hex | + hex := aStream peek: 2. + hex !!= 'RE' and: [hex !!= 'VE'] and: [hex size = 2] and: [ + prefix := LegacyPrefix + withValue: hex first asUppercase digitValue * 16 + + hex second asUppercase digitValue. + prefix notNil]] + whileTrue: [ + prefixes add: prefix. + aStream upTo: Space] +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mnemonic + ^mnemonic +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mode + ^mode +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +opcode + ^opcode +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +opcode: aString + | reader | + opcode := self opcodeFrom: aString. + reader := opcode readStream. + prefixes := OrderedCollection new. + self + legacyPrefixesFrom: reader; + rexPrefixFrom: reader; + vexPrefixFrom: reader; + primaryOpcodeFrom: reader; + opcodeExtensionFrom: reader. + prefixes := prefixes asArray +! ! + +!InstructionSpec methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +opcodeExtensionFrom: aStream + (aStream peekFor: $/) ifFalse: [^self]. + extension := aStream peek digitValue < 8 ifTrue: [aStream next digitValue] +! ! + +!InstructionSpec methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +opcodeFrom: aString + (aString includesString: '66') ifTrue: [^aString]. + (instruction endsWith: '16, imm8') ifTrue: [^'66 ' , aString]. + (instruction endsWith: '16, imm16') ifTrue: [^'66 ' , aString]. + (instruction endsWith: ' ax, imm16') ifTrue: [^'66 ' , aString]. + ^aString +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand: index of: decoder + | op type | + op := opEncoding operand: index of: decoder. + type := operands at: index. + type isMoff ifTrue: [^type operandFrom: op value]. + op isMemory ifTrue: [op length: type memoryLength]. + op isImmediate ifTrue: [op length: type length]. + ^op +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operandEncoding + ^opEncoding +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operandEncoding: aString + opEncoding := OperandEncoding named: aString +! ! + +!InstructionSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +operandLength + operands do: [:op | op length ifNotNil: [:l | ^l]]. + ^nil +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands + ^operands +! ! + +!InstructionSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +operandsFrom: substrings + operands := substrings allButFirst collect: [:s | ISAOperandType named: s] +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefixes + ^prefixes +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +primaryOpcode + ^primary +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +primaryOpcodeFrom: aStream + | oc | + primary := #[]. + [ + aStream atEnd not + and: [ + oc := aStream peek: 2. + oc := self fixOpcode: oc. + oc size = 2] + and: [oc asUppercase = oc] + and: [oc conform: [:ch | ch isHexDigit]]] + whileTrue: [ + primary := primary + copyWith: oc first digitValue * 16 + oc second digitValue. + aStream upTo: Space] +! ! + +!InstructionSpec methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + instruction isNil ifTrue: [^super printOn: aStream]. + aStream nextPutAll: instruction +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +properties + ^properties +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +protected + ^protected +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +rexPrefixFrom: aStream + | rex | + (aStream peekForAll: 'REX') ifTrue: [ + aStream skip: 'REX' size negated. + rex := REXPrefix fromStream: aStream. + aStream upTo: Space. + prefixes add: rex] +! ! + +!InstructionSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +useful + ^useful +! ! + +!InstructionSpec methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +vexPrefixFrom: aStream + | vex | + (aStream peekForAll: 'VEX') ifTrue: [ + aStream skip: 'VEX' size negated. + vex := VEXPrefix fromStream: aStream. + prefixes add: vex] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InstructionSpec class' category: #'Powerlang-Core-Assembler-Intel'! +InstructionSpec class + instanceVariableNames: 'Specs'! + +!InstructionSpec class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +addendum32 + ^' +FF /2 CALL r/m32 M rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 NE V Call near, absolute indirect, address given in r/m32. +48 +rw DEC r16 O NE V Decrement r16 by 1. +48 +rd DEC r32 O NE V Decrement r32 by 1. +40 +rw INC r16 O NE V Increment word register by 1. +40 +rd INC r32 O NE V Increment doubleword register by 1. +FF /4 JMP r/m32 M R NS V Jump near, absolute indirect, address given in r/m32. Not supported in 64-bit mode. + +66 REX.W+ 0F 3A 22 /r ib PINSRQ xmm1, r/m64, imm8 RMI NE V SSE4_1 pinsrq Insert a qword integer value from r/m64 into the xmm1 at the destination element specified by imm8. +8F /0 POP r/m32 M RSP RSP NE V Pop top of stack into m32; increment stack pointer. +58 +rd POP r32 O RSP RSP NE V Pop top of stack into r32; increment stack pointer. +FF /6 PUSH r/m32 M RSP RSP NE V Push r/m32. +50 +rd PUSH r32 O RSP RSP NE V YES Push r32.' +! ! + +!InstructionSpec class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +bestMatchForMnemonic: aString operands: operands + | current family | + current := nil. + family := Specs at: aString. + family do: [:spec | | fits | + fits := spec acceptsOperands: operands. + fits ifTrue: [ + spec isPreferred ifTrue: [^spec]. + (current isNil or: [spec isPreferredTo: current for: operands]) + ifTrue: [current := spec]]]. + current ifNil: [self error: 'cannot identify the instruction']. + ^current +! ! + +!InstructionSpec class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +bestMatchForMnemonic: aString operands: operands wordSize: wordSize + | current family | + current := nil. + family := Specs at: aString. + family + select: [:spec | (spec existsInWordSize: wordSize) + and: [spec acceptsOperands: operands]] + thenDo: [:spec | + spec isPreferred ifTrue: [^spec]. + (current isNil or: [spec isPreferredTo: current for: operands]) + ifTrue: [current := spec]]. + current ifNil: [self error: 'cannot identify the instruction']. + ^current +! ! + +!InstructionSpec class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +byteSpecs + ^self selectSpecs: [:s | s opcode includesString: '+r'] +! ! + +!InstructionSpec class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +fromString: aString + ^self new fromString: aString +! ! + +!InstructionSpec class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + OperandEncoding initializeEncodings. + Prefixes initialize. + VEXPrefix initializeSignatures. + ISAOperandType initialize. + self initializeSpecs. + Smalltalk at: #Decoder64 ifPresent: [ :d | d initializeSpecs ] + +! ! + +!InstructionSpec class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeSpecs + | dict reader | + dict := Dictionary new. + reader := (self x86 , self addendum32) readStream. + reader nextLine. + [reader atEnd] whileFalse: [| line spec family | + line := reader nextLine. + line trimBlanks notEmpty ifTrue: [ + spec := self fromString: line. + family := dict at: spec mnemonic ifAbsentPut: [OrderedCollection new]. + (spec arity = 0 orNot: [spec operandEncoding isNil]) + ifTrue: [family add: spec]]]. + Specs := dict +! ! + +!InstructionSpec class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +selectSpecs: aBlock + ^Array + streamContents: [:strm | Specs + do: [:specs | specs select: aBlock thenDo: [:s | strm nextPut: s]]] +! ! + +!InstructionSpec class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +specsByOpcode + | specs | + specs := Dictionary new. + Specs do: [:family | + family do: [:s | | group | + group := specs at: s primaryOpcode ifAbsentPut: [OrderedCollection new]. + group add: s]]. + ^specs +! ! + +!InstructionSpec class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +specsCollect: aBlock + ^Array streamContents: [:strm | + Specs + do: [:specs | specs + collect: aBlock + thenDo: [:aspect | strm nextPut: aspect]]] +! ! + +!InstructionSpec class methodsFor: 'documentation' stamp: 'KenD 28/Jun/2026 13:27:40'! +x86 + ^ +'Opcode Instruction Op/En Properties Implicit Read Implicit Write Implicit Undef Useful Protected 64-bit Mode Compat/32-bit-Legacy Mode CPUID Feature Flags AT&T Mnemonic Preferred Description + +37 AAA I V ASCII adjust AL after addition. + +D5 0A AAD I V ASCII adjust AX before division. +D5 ib AAD imm8 I V Adjust AX before division to number base imm8. + +D4 0A AAM I V ASCII adjust AX after multiply. +D4 ib AAM imm8 I V Adjust AX after multiply to number base imm8. + +3F AAS I V ASCII adjust AL after subtraction. + +14 ib ADC AL, imm8 I RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcb Add with carry imm8 to AL +15 iw ADC AX, imm16 I RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcw Add with carry imm16 to AX. +15 id ADC EAX, imm32 I RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcl Add with carry imm32 to EAX. +REX.W+ 15 id ADC RAX, imm32 I RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V NE adcq Add with carry imm32 sign extended to 64- bits to RAX. +80 /2 ib ADC r/m8, imm8 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcb Add with carry imm8 to r/m8. +REX+ 80 /2 ib ADC r/m8, imm8 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V NE adcb Add with carry imm8 to r/m8. +81 /2 iw ADC r/m16, imm16 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcw Add with carry imm16 to r/m16. +81 /2 id ADC r/m32, imm32 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcl Add with CF imm32 to r/m32. +REX.W+ 81 /2 id ADC r/m64, imm32 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V NE adcq Add with CF imm32 sign extended to 64-bits to r/m64. +83 /2 ib ADC r/m16, imm8 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcw YES Add with CF sign-extended imm8 to r/m16. +83 /2 ib ADC r/m32, imm8 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcl YES Add with CF sign-extended imm8 into r/m32. +REX.W+ 83 /2 ib ADC r/m64, imm8 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V NE adcq YES Add with CF sign-extended imm8 into r/m64. +10 /r ADC r/m8, r8 MR RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcb YES Add with carry byte register to r/m8. +REX+ 10 /r ADC r/m8, r8 MR RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V NE adcb YES Add with carry byte register to r/m8. +11 /r ADC r/m16, r16 MR RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcw YES Add with carry r16 to r/m16. +11 /r ADC r/m32, r32 MR RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcl YES Add with CF r32 to r/m32. +REX.W+ 11 /r ADC r/m64, r64 MR RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V NE adcq YES Add with CF r64 to r/m64. +12 /r ADC r8, r/m8 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcb Add with carry r/m8 to byte register. +REX+ 12 /r ADC r8, r/m8 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V NE adcb Add with carry r/m64 to byte register. +13 /r ADC r16, r/m16 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcw Add with carry r/m16 to r16. +13 /r ADC r32, r/m32 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V V adcl Add with CF r/m32 to r32. +REX.W+ 13 /r ADC r64, r/m64 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.CF E.PF V NE adcq Add with CF r/m64 to r64. + +04 ib ADD AL, imm8 I RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addb Add imm8 to AL. +05 iw ADD AX, imm16 I RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addw Add imm16 to AX. +05 id ADD EAX, imm32 I RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addl Add imm32 to EAX. +REX.W+ 05 id ADD RAX, imm32 I RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE addq Add imm32 sign-extended to 64-bits to RAX. +80 /0 ib ADD r/m8, imm8 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addb Add imm8 to r/m8. +REX+ 80 /0 ib ADD r/m8, imm8 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE addb Add sign-extended imm8 to r/m64. +81 /0 iw ADD r/m16, imm16 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addw Add imm16 to r/m16. +81 /0 id ADD r/m32, imm32 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addl Add imm32 to r/m32. +REX.W+ 81 /0 id ADD r/m64, imm32 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE addq Add imm32 sign-extended to 64-bits to r/m64. +83 /0 ib ADD r/m16, imm8 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addw YES Add sign-extended imm8 to r/m16. +83 /0 ib ADD r/m32, imm8 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addl YES Add sign-extended imm8 to r/m32. +REX.W+ 83 /0 ib ADD r/m64, imm8 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE addq YES Add sign-extended imm8 to r/m64. +00 /r ADD r/m8, r8 MR RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addb YES Add r8 to r/m8. +REX+ 00 /r ADD r/m8, r8 MR RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE addb YES Add r8 to r/m8. +01 /r ADD r/m16, r16 MR RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addw YES Add r16 to r/m16. +01 /r ADD r/m32, r32 MR RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addl YES Add r32 to r/m32. +REX.W+ 01 /r ADD r/m64, r64 MR RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE addq YES Add r64 to r/m64. +02 /r ADD r8, r/m8 RM RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addb Add r/m8 to r8. +REX+ 02 /r ADD r8, r/m8 RM RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE addb Add r/m8 to r8. +03 /r ADD r16, r/m16 RM RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addw Add r/m16 to r16. +03 /r ADD r32, r/m32 RM RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V addl Add r/m32 to r32. +REX.W+ 03 /r ADD r64, r/m64 RM RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE addq Add r/m64 to r64. + +66 0F 58 /r ADDPD xmm1, xmm2/m128 RM RW, R V V SSE2 addpd Add packed double-precision floating-point values from xmm2/m128 to xmm1. +VEX.NDS.128.66.0F.WIG 58 /r VADDPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vaddpd Add packed double-precision floating-point values from xmm3/mem to xmm2 and stores result in xmm1. +VEX.NDS.256.66.0F.WIG 58 /r VADDPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vaddpd Add packed double-precision floating-point values from ymm3/mem to ymm2 and stores result in ymm1. + +0F 58 /r ADDPS xmm1, xmm2/m128 RM RW, R V V SSE addps Add packed single-precision floating-point values from xmm2/m128 to xmm1 and stores result in xmm1. +VEX.NDS.128.0F.WIG 58 /r VADDPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vaddps Add packed single-precision floating-point values from xmm3/mem to xmm2 and stores result in xmm1. +VEX.NDS.256.0F.WIG 58 /r VADDPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vaddps Add packed single-precision floating-point values from ymm3/mem to ymm2 and stores result in ymm1. + +F2 0F 58 /r ADDSD xmm1, xmm2/m64 RM RW, R V V SSE2 addsd Add the low double-precision floating-point value from xmm2/m64 to xmm1. +VEX.NDS.LIG.F2.0F.WIG 58 /r VADDSD xmm1, xmm2, xmm3/m64 RVM Z, R, R V V AVX vaddsd Add the low double-precision floating-point value from xmm3/mem to xmm2 and store the result in xmm1. + +F3 0F 58 /r ADDSS xmm1, xmm2/m32 RM RW, R V V SSE addss Add the low single-precision floating-point value from xmm2/m32 to xmm1. +VEX.NDS.LIG.F3.0F.WIG 58 /r VADDSS xmm1, xmm2, xmm3/m32 RVM Z, R, R V V AVX vaddss Add the low single-precision floating-point value from xmm3/mem to xmm2 and store the result in xmm1. + +66 0F D0 /r ADDSUBPD xmm1, xmm2/m128 RM RW, R V V PNI addsubpd Add/subtract double-precision floating-point values from xmm2/m128 to xmm1. +VEX.NDS.128.66.0F.WIG D0 /r VADDSUBPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vaddsubpd Add/subtract packed double-precision floating-point values from xmm3/mem to xmm2 and stores result in xmm1. +VEX.NDS.256.66.0F.WIG D0 /r VADDSUBPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vaddsubpd Add / subtract packed double-precision floating-point values from ymm3/mem to ymm2 and stores result in ymm1. + +F2 0F D0 /r ADDSUBPS xmm1, xmm2/m128 RM RW, R V V PNI addsubps Add/subtract single-precision floating-point values from xmm2/m128 to xmm1. +VEX.NDS.128.F2.0F.WIG D0 /r VADDSUBPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vaddsubps Add/subtract single-precision floating-point values from xmm3/mem to xmm2 and stores result in xmm1. +VEX.NDS.256.F2.0F.WIG D0 /r VADDSUBPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vaddsubps Add / subtract single-precision floating-point values from ymm3/mem to ymm2 and stores result in ymm1. + +66 0F 38 DE /r AESDEC xmm1, xmm2/m128 RM RW, R V V AES aesdec Perform one round of an AES decryption flow, using the Equivalent Inverse Cipher, operating on a 128-bit data (state) from xmm1 with a 128-bit round key from xmm2/m128. +VEX.NDS.128.66.0F38.WIG DE /r VAESDEC xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AES AVX vaesdec Perform one round of an AES decryption flow, using the Equivalent Inverse Cipher, operating on a 128-bit data (state) from xmm2 with a 128-bit round key from xmm3/m128; store the result in xmm1. + +66 0F 38 DF /r AESDECLAST xmm1, xmm2/m128 RM RW, R V V AES aesdeclast Perform the last round of an AES decryption flow, using the Equivalent Inverse Cipher, operating on a 128-bit data (state) from xmm1 with a 128-bit round key from xmm2/m128. +VEX.NDS.128.66.0F38.WIG DF /r VAESDECLAST xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AES AVX vaesdeclast Perform the last round of an AES decryption flow, using the Equivalent Inverse Cipher, operating on a 128-bit data (state) from xmm2 with a 128-bit round key from xmm3/m128; store the result in xmm1. + +66 0F 38 DC /r AESENC xmm1, xmm2/m128 RM RW, R V V AES aesenc Perform one round of an AES encryption flow, operating on a 128-bit data (state) from xmm1 with a 128-bit round key from xmm2/m128. +VEX.NDS.128.66.0F38.WIG DC /r VAESENC xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AES AVX vaesenc Perform one round of an AES encryption flow, operating on a 128-bit data (state) from xmm2 with a 128-bit round key from the xmm3/m128; store the result in xmm1. + +66 0F 38 DD /r AESENCLAST xmm1, xmm2/m128 RM RW, R V V AES aesenclast Perform the last round of an AES encryption flow, operating on a 128-bit data (state) from xmm1 with a 128-bit round key from xmm2/m128. +VEX.NDS.128.66.0F38.WIG DD /r VAESENCLAST xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AES AVX vaesenclast Perform the last round of an AES encryption flow, operating on a 128-bit data (state) from xmm2 with a 128 bit round key from xmm3/m128; store the result in xmm1. + +66 0F 38 DB /r AESIMC xmm1, xmm2/m128 RM W, R V V AES aesimc Perform the InvMixColumn transformation on a 128-bit round key from xmm2/m128 and store the result in xmm1. +VEX.128.66.0F38.WIG DB /r VAESIMC xmm1, xmm2/m128 RM Z, R V V AES AVX vaesimc Perform the InvMixColumn transformation on a 128-bit round key from xmm2/m128 and store the result in xmm1. + +66 0F 3A DF /r ib AESKEYGENASSIST xmm1, xmm2/m128, imm8 RMI W, R, R V V AES aeskeygenassist Assist in AES round key generation using an 8 bits Round Constant (RCON) specified in the immediate byte, operating on 128 bits of data specified in xmm2/m128 and stores the result in xmm1. +VEX.128.66.0F3A.WIG DF /r ib VAESKEYGENASSIST xmm1, xmm2/m128, imm8 RMI Z, R, R V V AES AVX vaeskeygenassist Assist in AES round key generation using 8 bits Round Constant (RCON) specified in the immediate byte, operating on 128 bits of data specified in xmm2/m128 and stores the result in xmm1. + +24 ib AND AL, imm8 I RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andb AL AND imm8. +25 iw AND AX, imm16 I RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andw AX AND imm16. +25 id AND EAX, imm32 I RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andl EAX AND imm32. +REX.W+ 25 id AND RAX, imm32 I RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE andq RAX AND imm32 sign-extended to 64-bits. +80 /4 ib AND r/m8, imm8 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andb r/m8 AND imm8. +REX+ 80 /4 ib AND r/m8, imm8 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE andb r/m8 AND imm8. +81 /4 iw AND r/m16, imm16 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andw r/m16 AND imm16. +81 /4 id AND r/m32, imm32 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andl r/m32 AND imm32. +REX.W+ 81 /4 id AND r/m64, imm32 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE andq r/m64 AND imm32 sign extended to 64-bits. +83 /4 ib AND r/m16, imm8 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andw YES r/m16 AND imm8 (sign-extended). +83 /4 ib AND r/m32, imm8 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andl YES r/m32 AND imm8 (sign-extended). +REX.W+ 83 /4 ib AND r/m64, imm8 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE andq YES r/m64 AND imm8 (sign-extended). +20 /r AND r/m8, r8 MR RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andb YES r/m8 AND r8. +REX+ 20 /r AND r/m8, r8 MR RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE andb YES r/m64 AND r8 (sign-extended). +21 /r AND r/m16, r16 MR RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andw YES r/m16 AND r16. +21 /r AND r/m32, r32 MR RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andl YES r/m32 AND r32. +REX.W+ 21 /r AND r/m64, r64 MR RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE andq YES r/m64 AND r32. +22 /r AND r8, r/m8 RM RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andb r8 AND r/m8. +REX+ 22 /r AND r8, r/m8 RM RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE andb r/m64 AND r8 (sign-extended). +23 /r AND r16, r/m16 RM RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andw r16 AND r/m16. +23 /r AND r32, r/m32 RM RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V andl r32 AND r/m32. +REX.W+ 23 /r AND r64, r/m64 RM RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE andq r64 AND r/m64. + +VEX.NDS.LZ.0F38.W0 F2 /r ANDN r32a, r32b, r/m32 RVM W, R, R E.SF E.ZF E.OF E.CF E.AF E.PF V V BMI1 andnl Bitwise AND of inverted r32b with r/m32, store result in r32a +VEX.NDS.LZ.0F38.W1 F2 /r ANDN r64a, r64b, r/m64 RVM W, R, R E.SF E.ZF E.OF E.CF E.AF E.PF V NE BMI1 andnq Bitwise AND of inverted r64b with r/m64, store result in r64a + +66 0F 54 /r ANDPD xmm1, xmm2/m128 RM RW, R V V SSE2 andpd Return the bitwise logical AND of packed double-precision floating-point values in xmm1 and xmm2/m128. +VEX.NDS.128.66.0F.WIG 54 /r VANDPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vandpd Return the bitwise logical AND of packed double-precision floating-point values in xmm2 and xmm3/mem. +VEX.NDS.256.66.0F.WIG 54 /r VANDPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vandpd Return the bitwise logical AND of packed double-precision floating-point values in ymm2 and ymm3/mem. + +0F 54 /r ANDPS xmm1, xmm2/m128 RM RW, R V V SSE andps Bitwise logical AND of xmm2/m128 and xmm1. +VEX.NDS.128.0F.WIG 54 /r VANDPS xmm1,xmm2, xmm3/m128 RVM Z, R, R V V AVX vandps Return the bitwise logical AND of packed single-precision floating-point values in xmm2 and xmm3/mem. +VEX.NDS.256.0F.WIG 54 /r VANDPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vandps Return the bitwise logical AND of packed single-precision floating-point values in ymm2 and ymm3/mem. + +66 0F 55 /r ANDNPD xmm1, xmm2/m128 RM RW, R V V SSE2 andnpd Bitwise logical AND NOT of xmm2/m128 and xmm1. +VEX.NDS.128.66.0F.WIG 55 /r VANDNPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vandnpd Return the bitwise logical AND NOT of packed double-precision floating-point values in xmm2 and xmm3/mem. +VEX.NDS.256.66.0F.WIG 55 /r VANDNPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vandnpd Return the bitwise logical AND NOT of packed double-precision floating-point values in ymm2 and ymm3/mem. + +0F 55 /r ANDNPS xmm1, xmm2/m128 RM RW, R V V SSE andnps Bitwise logical AND NOT of xmm2/m128 and xmm1. +VEX.NDS.128.0F.WIG 55 /r VANDNPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vandnps Return the bitwise logical AND NOT of packed single-precision floating-point values in xmm2 and xmm3/mem. +VEX.NDS.256.0F.WIG 55 /r VANDNPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vandnps Return the bitwise logical AND NOT of packed single-precision floating-point values in ymm2 and ymm3/mem. + +63 /r ARPL r/m16, r16 YES NO NE V Adjust RPL of r/m16 to not less than RPL of r16. + +66 0F 3A 0D /r ib BLENDPD xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSE4_1 blendpd Select packed DP-FP values from xmm1 and xmm2/m128 from mask specified in imm8 and store the values into xmm1. +VEX.NDS.128.66.0F3A.WIG 0D /r ib VBLENDPD xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vblendpd Select packed double-precision floating-point values from xmm2 and xmm3/m128 from mask in imm8 and store the values in xmm1. +VEX.NDS.256.66.0F3A.WIG 0D /r ib VBLENDPD ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX vblendpd Select packed double-precision floating-point values from ymm2 and ymm3/m256 from mask in imm8 and store the values in ymm1. + +VEX.NDS.LZ.0F38.W0 F7 /r BEXTR r32a, r/m32, r32b RMV W, R, R E.ZF E.OF E.CF E.AF E.SF E.PF V V BMI1 bextrl Contiguous bitwise extract from r/m32 using r32b as control; store result in r32a. +VEX.NDS.LZ.0F38.W1 F7 /r BEXTR r64a, r/m64, r64b RMV W, R, R E.ZF E.OF E.CF E.AF E.SF E.PF V NE BMI1 bextrq Contiguous bitwise extract from r/m64 using r64b as control; store result in r64a + +66 0F 3A 0C /r ib BLENDPS xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSE4_1 blendps Select packed single precision floating-point values from xmm1 and xmm2/m128 from mask specified in imm8 and store the values into xmm1. +VEX.NDS.128.66.0F3A.WIG 0C /r ib VBLENDPS xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vblendps Select packed single-precision floating-point values from xmm2 and xmm3/m128 from mask in imm8 and store the values in xmm1. +VEX.NDS.256.66.0F3A.WIG 0C /r ib VBLENDPS ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX vblendps Select packed single-precision floating-point values from ymm2 and ymm3/m256 from mask in imm8 and store the values in ymm1. + +66 0F 38 15 /r BLENDVPD xmm1, xmm2/m128, RM0 RW, R, R V V SSE4_1 blendvpd Select packed DP FP values from xmm1 and xmm2 from mask specified in XMM0 and store the values in xmm1. +VEX.NDS.128.66.0F3A.W0 4B /r /is4 VBLENDVPD xmm1, xmm2, xmm3/m128, xmm4 RVMR Z, R, R, R V V AVX vblendvpd Conditionally copy double-precision floating- point values from xmm2 or xmm3/m128 to xmm1, based on mask bits in the mask operand, xmm4. +VEX.NDS.256.66.0F3A.W0 4B /r /is4 VBLENDVPD ymm1, ymm2, ymm3/m256, ymm4 RVMR W, R, R, R V V AVX vblendvpd Conditionally copy double-precision floating- point values from ymm2 or ymm3/m256 to ymm1, based on mask bits in the mask operand, ymm4. + +66 0F 38 14 /r BLENDVPS xmm1, xmm2/m128, RM0 RW, R, R V V SSE4_1 blendvps Select packed single precision floating-point values from xmm1 and xmm2/m128 from mask specified in XMM0 and store the values into xmm1. +VEX.NDS.128.66.0F3A.W0 4A /r /is4 VBLENDVPS xmm1, xmm2, xmm3/m128, xmm4 RVMR Z, R, R, R V V AVX vblendvps Conditionally copy single-precision floating- point values from xmm2 or xmm3/m128 to xmm1, based on mask bits in the specified mask operand, xmm4. +VEX.NDS.256.66.0F3A.W0 4A /r /is4 VBLENDVPS ymm1, ymm2, ymm3/m256, ymm4 RVMR W, R, R, R V V AVX vblendvps Conditionally copy single-precision floating- point values from ymm2 or ymm3/m256 to ymm1, based on mask bits in the specified mask register, ymm4. + +VEX.NDD.LZ.0F38.W0 F3 /3 BLSI r32, r/m32 VM RW, R E.ZF E.SF E.OF E.CF E.AF E.PF V V BMI1 blsil Extract lowest set bit from r/m32 and set that bit in r32. +VEX.NDD.LZ.0F38.W1 F3 /3 BLSI r64, r/m64 VM RW, R E.ZF E.SF E.OF E.CF E.AF E.PF V NE BMI1 blsiq Extract lowest set bit from r/m64, and set that bit in r64. + +VEX.NDD.LZ.0F38.W0 F3 /2 BLSMSK r32, r/m32 VM RW, R E.ZF E.SF E.OF E.CF E.AF E.PF V V BMI1 blsmskl Set all lower bits in r32 to "1" starting from bit 0 to lowest set bit in r/m32 +VEX.NDD.LZ.0F38.W1 F3 /2 BLSMSK r64, r/m64 VM RW, R E.ZF E.SF E.OF E.CF E.AF E.PF V NE BMI1 blsmskq Set all lower bits in r64 to "1" starting from bit 0 to lowest set bit in r/m64 + +VEX.NDD.LZ.0F38.W0 F3 /1 BLSR r32, r/m32 VM W, R E.ZF E.SF E.OF E.CF E.AF E.PF V V BMI1 blsrl Reset lowest set bit of r/m32, keep all other bits of r/m32 and write result to r32. +VEX.NDD.LZ.0F38.W1 F3 /1 BLSR r64, r/m64 VM W, R E.ZF E.SF E.OF E.CF E.AF E.PF V NE BMI1 blsrq Reset lowest set bit of r/m64, keep all other bits of r/m64 and write result to r64. + +62 /r BOUND r16, m16&16 I V Check if r16 (array index) is within bounds specified by m16&16. +62 /r BOUND r32, m32&32 I V Check if r32 (array index) is within bounds specified by m16&16. + +0F BC /r BSF r16, r/m16 RM uw, R E.ZF E.CF E.OF E.SF E.AF E.PF V V bsfw Bit scan forward on r/m16. +0F BC /r BSF r32, r/m32 RM uz, R E.ZF E.CF E.OF E.SF E.AF E.PF V V bsfl Bit scan forward on r/m32. +REX.W+ 0F BC BSF r64, r/m64 RM uw, R E.ZF E.CF E.OF E.SF E.AF E.PF V NE bsfq Bit scan forward on r/m64. + +0F BD /r BSR r16, r/m16 RM uw, R E.ZF E.CF E.OF E.SF E.AF E.PF V V bsrw Bit scan reverse on r/m16. +0F BD /r BSR r32, r/m32 RM uz, R E.ZF E.CF E.OF E.SF E.AF E.PF V V bsrl Bit scan reverse on r/m32. +REX.W+ 0F BD BSR r64, r/m64 RM uw, R E.ZF E.CF E.OF E.SF E.AF E.PF V NE bsrq Bit scan reverse on r/m64. + +0F C8 +rd BSWAP r32 O RW V V bswap Reverses the byte order of a 32-bit register. +REX.W+ 0F C8 +rd BSWAP r64 O RW V NE bswap Reverses the byte order of a 64-bit register. + +0F A3 BT r/m16, r16 MR R, R E.CF E.OF E.SF E.AF E.PF V V btw Store selected bit in CF flag. +0F A3 BT r/m32, r32 MR R, R E.CF E.OF E.SF E.AF E.PF V V btl Store selected bit in CF flag. +REX.W+ 0F A3 BT r/m64, r64 MR R, R E.CF E.OF E.SF E.AF E.PF V NE btq Store selected bit in CF flag. +0F BA /4 ib BT r/m16, imm8 MI R, R E.CF E.OF E.SF E.AF E.PF V V btw Store selected bit in CF flag. +0F BA /4 ib BT r/m32, imm8 MI R, R E.CF E.OF E.SF E.AF E.PF V V btl Store selected bit in CF flag. +REX.W+ 0F BA /4 ib BT r/m64, imm8 MI R, R E.CF E.OF E.SF E.AF E.PF V NE btq Store selected bit in CF flag. + +0F BB BTC r/m16, r16 MR RW, R E.CF E.OF E.SF E.AF E.PF V V btcw Store selected bit in CF flag and complement. +0F BB BTC r/m32, r32 MR RW, R E.CF E.OF E.SF E.AF E.PF V V btcl Store selected bit in CF flag and complement. +REX.W+ 0F BB BTC r/m64, r64 MR RW, R E.CF E.OF E.SF E.AF E.PF V NE btcq Store selected bit in CF flag and complement. +0F BA /7 ib BTC r/m16, imm8 MI RW, R E.CF E.OF E.SF E.AF E.PF V V btcw Store selected bit in CF flag and complement. +0F BA /7 ib BTC r/m32, imm8 MI RW, R E.CF E.OF E.SF E.AF E.PF V V btcl Store selected bit in CF flag and complement. +REX.W+ 0F BA /7 ib BTC r/m64, imm8 MI RW, R E.CF E.OF E.SF E.AF E.PF V NE btcq Store selected bit in CF flag and complement. + +0F B3 BTR r/m16, r16 MR RW, R E.CF E.OF E.SF E.AF E.PF V V btrw Store selected bit in CF flag and clear. +0F B3 BTR r/m32, r32 MR RW, R E.CF E.OF E.SF E.AF E.PF V V btrl Store selected bit in CF flag and clear. +REX.W+ 0F B3 BTR r/m64, r64 MR RW, R E.CF E.OF E.SF E.AF E.PF V NE btrq Store selected bit in CF flag and clear. +0F BA /6 ib BTR r/m16, imm8 MI RW, R E.CF E.OF E.SF E.AF E.PF V V btrw Store selected bit in CF flag and clear. +0F BA /6 ib BTR r/m32, imm8 MI RW, R E.CF E.OF E.SF E.AF E.PF V V btrl Store selected bit in CF flag and clear. +REX.W+ 0F BA /6 ib BTR r/m64, imm8 MI RW, R E.CF E.OF E.SF E.AF E.PF V NE btrq Store selected bit in CF flag and clear. + +0F AB BTS r/m16, r16 MR RW, R E.CF E.OF E.SF E.AF E.PF V V btsw Store selected bit in CF flag and set. +0F AB BTS r/m32, r32 MR RW, R E.CF E.OF E.SF E.AF E.PF V V btsl Store selected bit in CF flag and set. +REX.W+ 0F AB BTS r/m64, r64 MR RW, R E.CF E.OF E.SF E.AF E.PF V NE btsq Store selected bit in CF flag and set. +0F BA /5 ib BTS r/m16, imm8 MI RW, R E.CF E.OF E.SF E.AF E.PF V V btsw Store selected bit in CF flag and set. +0F BA /5 ib BTS r/m32, imm8 MI RW, R E.CF E.OF E.SF E.AF E.PF V V btsl Store selected bit in CF flag and set. +REX.W+ 0F BA /5 ib BTS r/m64, imm8 MI RW, R E.CF E.OF E.SF E.AF E.PF V NE btsq Store selected bit in CF flag and set. + +VEX.NDS.LZ.0F38.W0 F5 /r BZHI r32a, r/m32, r32b RMV W, R, R E.ZF E.CF E.SF E.OF E.AF E.PF V V BMI2 bzhil Zero bits in r/m32 starting with the position in r32b, write result to r32a. +VEX.NDS.LZ.0F38.W1 F5 /r BZHI r64a, r/m64, r64b RMV W, R, R E.ZF E.CF E.SF E.OF E.AF E.PF V NE BMI2 bzhiq Zero bits in r/m64 starting with the position in r64b, write result to r64a. + +E8 cw CALL rel16 rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 NS V Call near, relative, displacement relative to next instruction. +E8 cd CALL rel32 D R rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 V V callq Call near, relative, displacement relative to next instruction. 32-bit displacement sign extended to 64-bits in 64-bit mode. +FF /2 CALL r/m16 rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 NE V Call near, absolute indirect, address given in r/m16. +FF /2 CALL r/m32 rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 NE V Call near, absolute indirect, address given in r/m32. +FF /2 CALL r/m64 M R rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 V NE callq Call near, absolute indirect, address given in r/m64. +9A cd CALL ptr16:16 rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 I V Call far, absolute, address given in operand. +9A cp CALL ptr16:32 rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 I V Call far, absolute, address given in operand. +FF /3 CALL m16:16 M R rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 V V callq Call far, absolute indirect address given in m16:16. In 32-bit mode: if selector points to a gate, then RIP = 32-bit zero extended displacement taken from gate; else RIP = zero extended 16- bit offset from far pointer referenced in the instruction. +FF /3 CALL m16:32 M R rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 V V callq In 64-bit mode: If selector points to a gate, then RIP = 64-bit displacement taken from gate; else RIP = zero extended 32-bit offset from far pointer referenced in the instruction. +REX.W+ FF /3 CALL m16:64 M R rdi rsi rdx rcx r8 r9 rax xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7 RAX RDX XMM0 XMM1 RDI RSI RCX R8 R9 R10 R11 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 V NE callq In 64-bit mode: If selector points to a gate, then RIP = 64-bit displacement taken from gate; else RIP = 64-bit offset from far pointer referenced in the instruction. + +PREF.66+ 98 CBW NP AL AX V V cbtw AX = sign-extend of AL. +98 CWDE NP AX RAX V V cwtl EAX = sign-extend of AX. +REX.W+ 98 CDQE NP EAX RAX V NE cltq RAX = sign-extend of EAX. + +F8 CLC NP E.CF V V clc Clear CF flag. + +FC CLD NP E.DF V V cld Clear DF flag. + +0F AE /7 CLFLUSH m8 M I V V CLFLUSH clflush Flushes cache line containing m8. + +FA CLI NP E.VM E.IOPL E.VIP e.if e.vif V V cli Clear interrupt flag; interrupts disabled when interrupt flag cleared. + +0F 06 CLTS NO YES V V Clears TS flag in CR0. + +F5 CMC NP E.CF E.CF V V cmc Complement CF flag. + +0F 47 /r CMOVA r16, r/m16 RM w, R E.CF E.ZF V V CMOV cmovaw Move if above (CF=0 and ZF=0). +0F 47 /r CMOVA r32, r/m32 RM z, R E.CF E.ZF V V CMOV cmoval Move if above (CF=0 and ZF=0). +REX.W+ 0F 47 /r CMOVA r64, r/m64 RM w, R E.CF E.ZF V NE CMOV cmovaq Move if above (CF=0 and ZF=0). +0F 43 /r CMOVAE r16, r/m16 RM w, R E.CF V V CMOV cmovaew Move if above or equal (CF=0). +0F 43 /r CMOVAE r32, r/m32 RM z, R E.CF V V CMOV cmovael Move if above or equal (CF=0). +REX.W+ 0F 43 /r CMOVAE r64, r/m64 RM w, R E.CF V NE CMOV cmovaeq Move if above or equal (CF=0). +0F 42 /r CMOVB r16, r/m16 RM w, R E.CF V V CMOV cmovbw Move if below (CF=1). +0F 42 /r CMOVB r32, r/m32 RM z, R E.CF V V CMOV cmovbl Move if below (CF=1). +REX.W+ 0F 42 /r CMOVB r64, r/m64 RM w, R E.CF V NE CMOV cmovbq Move if below (CF=1). +0F 46 /r CMOVBE r16, r/m16 RM w, R E.CF E.ZF V V CMOV cmovbew Move if below or equal (CF=1 or ZF=1). +0F 46 /r CMOVBE r32, r/m32 RM z, R E.CF E.ZF V V CMOV cmovbel Move if below or equal (CF=1 or ZF=1). +REX.W+ 0F 46 /r CMOVBE r64, r/m64 RM w, R E.CF E.ZF V NE CMOV cmovbeq Move if below or equal (CF=1 or ZF=1). +0F 42 /r CMOVC r16, r/m16 RM w, R E.CF V V CMOV cmovcw Move if carry (CF=1). +0F 42 /r CMOVC r32, r/m32 RM z, R E.CF V V CMOV cmovcl Move if carry (CF=1). +REX.W+ 0F 42 /r CMOVC r64, r/m64 RM w, R E.CF V NE CMOV cmovcq Move if carry (CF=1). +0F 44 /r CMOVE r16, r/m16 RM w, R E.ZF V V CMOV cmovew Move if equal (ZF=1). +0F 44 /r CMOVE r32, r/m32 RM z, R E.ZF V V CMOV cmovel Move if equal (ZF=1). +REX.W+ 0F 44 /r CMOVE r64, r/m64 RM w, R E.ZF V NE CMOV cmoveq Move if equal (ZF=1). +0F 4F /r CMOVG r16, r/m16 RM w, R E.ZF E.SF E.OF V V CMOV cmovgw Move if greater (ZF=0 and SF=OF). +0F 4F /r CMOVG r32, r/m32 RM z, R E.ZF E.SF E.OF V V CMOV cmovgl Move if greater (ZF=0 and SF=OF). +REX.W+ 0F 4F /r CMOVG r64, r/m64 RM w, R E.ZF E.SF E.OF V NE CMOV cmovgq Move if greater (ZF=0 and SF=OF). +0F 4D /r CMOVGE r16, r/m16 RM w, R E.SF E.OF V V CMOV cmovgew Move if greater or equal (SF=OF). +0F 4D /r CMOVGE r32, r/m32 RM z, R E.SF E.OF V V CMOV cmovgel Move if greater or equal (SF=OF). +REX.W+ 0F 4D /r CMOVGE r64, r/m64 RM w, R E.SF E.OF V NE CMOV cmovgeq Move if greater or equal (SF=OF). +0F 4C /r CMOVL r16, r/m16 RM w, R E.SF E.OF V V CMOV cmovlw Move if less (SF !!= OF). +0F 4C /r CMOVL r32, r/m32 RM z, R E.SF E.OF V V CMOV cmovll Move if less (SF!!= OF). +REX.W+ 0F 4C /r CMOVL r64, r/m64 RM w, R E.SF E.OF V NE CMOV cmovlq Move if less (SF!!= OF). +0F 4E /r CMOVLE r16, r/m16 RM w, R E.ZF E.SF E.OF V V CMOV cmovlew Move if less or equal (ZF=1 or SF!!= OF). +0F 4E /r CMOVLE r32, r/m32 RM z, R E.ZF E.SF E.OF V V CMOV cmovlel Move if less or equal (ZF=1 or SF!!= OF). +REX.W+ 0F 4E /r CMOVLE r64, r/m64 RM w, R E.ZF E.SF E.OF V NE CMOV cmovleq Move if less or equal (ZF=1 or SF!!= OF). +0F 46 /r CMOVNA r16, r/m16 RM w, R E.CF E.ZF V V CMOV cmovnaw Move if not above (CF=1 or ZF=1). +0F 46 /r CMOVNA r32, r/m32 RM z, R E.CF E.ZF V V CMOV cmovnal Move if not above (CF=1 or ZF=1). +REX.W+ 0F 46 /r CMOVNA r64, r/m64 RM w, R E.CF E.ZF V NE CMOV cmovnaq Move if not above (CF=1 or ZF=1). +0F 42 /r CMOVNAE r16, r/m16 RM w, R E.CF V V CMOV cmovnaew Move if not above or equal (CF=1). +0F 42 /r CMOVNAE r32, r/m32 RM z, R E.CF V V CMOV cmovnael Move if not above or equal (CF=1). +REX.W+ 0F 42 /r CMOVNAE r64, r/m64 RM w, R E.CF V NE CMOV cmovnaeq Move if not above or equal (CF=1). +0F 43 /r CMOVNB r16, r/m16 RM w, R E.CF V V CMOV cmovnbw Move if not below (CF=0). +0F 43 /r CMOVNB r32, r/m32 RM z, R E.CF V V CMOV cmovnbl Move if not below (CF=0). +REX.W+ 0F 43 /r CMOVNB r64, r/m64 RM w, R E.CF V NE CMOV cmovnbq Move if not below (CF=0). +0F 47 /r CMOVNBE r16, r/m16 RM w, R E.CF E.ZF V V CMOV cmovnbew Move if not below or equal (CF=0 and ZF=0). +0F 47 /r CMOVNBE r32, r/m32 RM z, R E.CF E.ZF V V CMOV cmovnbel Move if not below or equal (CF=0 and ZF=0). +REX.W+ 0F 47 /r CMOVNBE r64, r/m64 RM w, R E.CF E.ZF V NE CMOV cmovnbeq Move if not below or equal (CF=0 and ZF=0). +0F 43 /r CMOVNC r16, r/m16 RM w, R E.CF V V CMOV cmovncw Move if not carry (CF=0). +0F 43 /r CMOVNC r32, r/m32 RM z, R E.CF V V CMOV cmovncl Move if not carry (CF=0). +REX.W+ 0F 43 /r CMOVNC r64, r/m64 RM w, R E.CF V NE CMOV cmovncq Move if not carry (CF=0). +0F 45 /r CMOVNE r16, r/m16 RM w, R E.ZF V V CMOV cmovnew Move if not equal (ZF=0). +0F 45 /r CMOVNE r32, r/m32 RM z, R E.ZF V V CMOV cmovnel Move if not equal (ZF=0). +REX.W+ 0F 45 /r CMOVNE r64, r/m64 RM w, R E.ZF V NE CMOV cmovneq Move if not equal (ZF=0). +0F 4E /r CMOVNG r16, r/m16 RM w, R E.ZF E.SF E.OF V V CMOV cmovngw Move if not greater (ZF=1 or SF!!= OF). +0F 4E /r CMOVNG r32, r/m32 RM z, R E.ZF E.SF E.OF V V CMOV cmovngl Move if not greater (ZF=1 or SF!!= OF). +REX.W+ 0F 4E /r CMOVNG r64, r/m64 RM w, R E.ZF E.SF E.OF V NE CMOV cmovngq Move if not greater (ZF=1 or SF!!= OF). +0F 4C /r CMOVNGE r16, r/m16 RM w, R E.SF E.OF V V CMOV cmovngew Move if not greater or equal (SF!!= OF). +0F 4C /r CMOVNGE r32, r/m32 RM z, R E.SF E.OF V V CMOV cmovngel Move if not greater or equal (SF!!= OF). +REX.W+ 0F 4C /r CMOVNGE r64, r/m64 RM w, R E.SF E.OF V NE CMOV cmovngeq Move if not greater or equal (SF!!= OF). +0F 4D /r CMOVNL r16, r/m16 RM w, R E.SF E.OF V V CMOV cmovnlw Move if not less (SF=OF). +0F 4D /r CMOVNL r32, r/m32 RM z, R E.SF E.OF V V CMOV cmovnll Move if not less (SF=OF). +REX.W+ 0F 4D /r CMOVNL r64, r/m64 RM w, R E.SF E.OF V NE CMOV cmovnlq Move if not less (SF=OF). +0F 4F /r CMOVNLE r16, r/m16 RM w, R E.ZF E.SF E.OF V V CMOV cmovnlew Move if not less or equal (ZF=0 and SF=OF). +0F 4F /r CMOVNLE r32, r/m32 RM z, R E.ZF E.SF E.OF V V CMOV cmovnlel Move if not less or equal (ZF=0 and SF=OF). +REX.W+ 0F 4F /r CMOVNLE r64, r/m64 RM w, R E.ZF E.SF E.OF V NE CMOV cmovnleq Move if not less or equal (ZF=0 and SF=OF). +0F 41 /r CMOVNO r16, r/m16 RM w, R E.OF V V CMOV cmovnow Move if not overflow (OF=0). +0F 41 /r CMOVNO r32, r/m32 RM z, R E.OF V V CMOV cmovnol Move if not overflow (OF=0). +REX.W+ 0F 41 /r CMOVNO r64, r/m64 RM w, R E.OF V NE CMOV cmovnoq Move if not overflow (OF=0). +0F 4B /r CMOVNP r16, r/m16 RM w, R E.PF V V CMOV cmovnpw Move if not parity (PF=0). +0F 4B /r CMOVNP r32, r/m32 RM z, R E.PF V V CMOV cmovnpl Move if not parity (PF=0). +REX.W+ 0F 4B /r CMOVNP r64, r/m64 RM w, R E.PF V NE CMOV cmovnpq Move if not parity (PF=0). +0F 49 /r CMOVNS r16, r/m16 RM w, R E.SF V V CMOV cmovnsw Move if not sign (SF=0). +0F 49 /r CMOVNS r32, r/m32 RM z, R E.SF V V CMOV cmovnsl Move if not sign (SF=0). +REX.W+ 0F 49 /r CMOVNS r64, r/m64 RM w, R E.SF V NE CMOV cmovnsq Move if not sign (SF=0). +0F 45 /r CMOVNZ r16, r/m16 RM w, R E.ZF V V CMOV cmovnzw Move if not zero (ZF=0). +0F 45 /r CMOVNZ r32, r/m32 RM z, R E.ZF V V CMOV cmovnzl Move if not zero (ZF=0). +REX.W+ 0F 45 /r CMOVNZ r64, r/m64 RM w, R E.ZF V NE CMOV cmovnzq Move if not zero (ZF=0). +0F 40 /r CMOVO r16, r/m16 RM w, R E.OF V V CMOV cmovow Move if overflow (OF=1). +0F 40 /r CMOVO r32, r/m32 RM z, R E.OF V V CMOV cmovol Move if overflow (OF=1). +REX.W+ 0F 40 /r CMOVO r64, r/m64 RM w, R E.OF V NE CMOV cmovoq Move if overflow (OF=1). +0F 4A /r CMOVP r16, r/m16 RM w, R E.PF V V CMOV cmovpw Move if parity (PF=1). +0F 4A /r CMOVP r32, r/m32 RM z, R E.PF V V CMOV cmovpl Move if parity (PF=1). +REX.W+ 0F 4A /r CMOVP r64, r/m64 RM w, R E.PF V NE CMOV cmovpq Move if parity (PF=1). +0F 4A /r CMOVPE r16, r/m16 RM w, R E.PF V V CMOV cmovpew Move if parity even (PF=1). +0F 4A /r CMOVPE r32, r/m32 RM z, R E.PF V V CMOV cmovpel Move if parity even (PF=1). +REX.W+ 0F 4A /r CMOVPE r64, r/m64 RM w, R E.PF V NE CMOV cmovpeq Move if parity even (PF=1). +0F 4B /r CMOVPO r16, r/m16 RM w, R E.PF V V CMOV cmovpow Move if parity odd (PF=0). +0F 4B /r CMOVPO r32, r/m32 RM z, R E.PF V V CMOV cmovpol Move if parity odd (PF=0). +REX.W+ 0F 4B /r CMOVPO r64, r/m64 RM w, R E.PF V NE CMOV cmovpoq Move if parity odd (PF=0). +0F 48 /r CMOVS r16, r/m16 RM w, R E.SF V V CMOV cmovsw Move if sign (SF=1). +0F 48 /r CMOVS r32, r/m32 RM z, R E.SF V V CMOV cmovsl Move if sign (SF=1). +REX.W+ 0F 48 /r CMOVS r64, r/m64 RM w, R E.SF V NE CMOV cmovsq Move if sign (SF=1). +0F 44 /r CMOVZ r16, r/m16 RM w, R E.ZF V V CMOV cmovzw Move if zero (ZF=1). +0F 44 /r CMOVZ r32, r/m32 RM z, R E.ZF V V CMOV cmovzl Move if zero (ZF=1). +REX.W+ 0F 44 /r CMOVZ r64, r/m64 RM w, R E.ZF V NE CMOV cmovzq Move if zero (ZF=1). + +3C ib CMP AL, imm8 I R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpb Compare imm8 with AL. +3D iw CMP AX, imm16 I R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpw Compare imm16 with AX. +3D id CMP EAX, imm32 I R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpl Compare imm32 with EAX. +REX.W+ 3D id CMP RAX, imm32 I R, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE cmpq Compare imm32 sign-extended to 64-bits with RAX. +80 /7 ib CMP r/m8, imm8 MI R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpb Compare imm8 with r/m8. +REX+ 80 /7 ib CMP r/m8, imm8 MI R, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE cmpb Compare imm8 with r/m8. +81 /7 iw CMP r/m16, imm16 MI R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpw Compare imm16 with r/m16. +81 /7 id CMP r/m32, imm32 MI R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpl Compare imm32 with r/m32. +REX.W+ 81 /7 id CMP r/m64, imm32 MI R, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE cmpq Compare imm32 sign-extended to 64-bits with r/m64. +83 /7 ib CMP r/m16, imm8 MI R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpw YES Compare imm8 with r/m16. +83 /7 ib CMP r/m32, imm8 MI R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpl YES Compare imm8 with r/m32. +REX.W+ 83 /7 ib CMP r/m64, imm8 MI R, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE cmpq YES Compare imm8 with r/m64. +38 /r CMP r/m8, r8 MR R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpb YES Compare r8 with r/m8. +REX+ 38 /r CMP r/m8, r8 MR R, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE cmpb YES Compare r8 with r/m8. +39 /r CMP r/m16, r16 MR R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpw YES Compare r16 with r/m16. +39 /r CMP r/m32, r32 MR R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpl YES Compare r32 with r/m32. +REX.W+ 39 /r CMP r/m64, r64 MR R, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE cmpq YES Compare r64 with r/m64. +3A /r CMP r8, r/m8 RM R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpb Compare r/m8 with r8. +REX+ 3A /r CMP r8, r/m8 RM R, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE cmpb Compare r/m8 with r8. +3B /r CMP r16, r/m16 RM R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpw Compare r/m16 with r16. +3B /r CMP r32, r/m32 RM R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpl Compare r/m32 with r32. +REX.W+ 3B /r CMP r64, r/m64 RM R, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE cmpq Compare r/m64 with r64. + +66 0F C2 /r ib CMPPD xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSE2 cmppd Compare packed double-precision floating- point values in xmm2/m128 and xmm1 using imm8 as comparison predicate. +VEX.NDS.128.66.0F.WIG C2 /r ib VCMPPD xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vcmppd Compare packed double-precision floating- point values in xmm3/m128 and xmm2 using bits 4:0 of imm8 as a comparison predicate. +VEX.NDS.256.66.0F.WIG C2 /r ib VCMPPD ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX vcmppd Compare packed double-precision floating- point values in ymm3/m256 and ymm2 using bits 4:0 of imm8 as a comparison predicate. + +0F C2 /r ib CMPPS xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSE cmpps Compare packed single-precision floating- point values in xmm2/mem and xmm1 using imm8 as comparison predicate. +VEX.NDS.128.0F.WIG C2 /r ib VCMPPS xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vcmpps Compare packed single-precision floating- point values in xmm3/m128 and xmm2 using bits 4:0 of imm8 as a comparison predicate. +VEX.NDS.256.0F.WIG C2 /r ib VCMPPS ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX vcmpps Compare packed single-precision floating- point values in ymm3/m256 and ymm2 using bits 4:0 of imm8 as a comparison predicate. + +A6 CMPS m8, m8 NP I, I E.DF ESI rsi EDI rdi E.CF E.OF E.SF E.ZF E.AF E.PF V V cmps For legacy mode, compare byte at address DS:(E)SI with byte at address ES:(E)DI; For 64-bit mode compare byte at address (R|E)SI to byte at address (R|E)DI. The status flags are set accordingly. +A7 CMPS m16, m16 NP I, I E.DF ESI rsi EDI rdi E.CF E.OF E.SF E.ZF E.AF E.PF V V cmps For legacy mode, compare word at address DS:(E)SI with word at address ES:(E)DI; For 64-bit mode compare word at address (R|E)SI with word at address (R|E)DI. The status flags are set accordingly. +A7 CMPS m32, m32 NP I, I E.DF ESI rsi EDI rdi E.CF E.OF E.SF E.ZF E.AF E.PF V V cmps For legacy mode, compare dword at address DS:(E)SI at dword at address ES:(E)DI; For 64-bit mode compare dword at address (R|E)SI at dword at address (R|E)DI. The status flags are set accordingly. +REX.W+ A7 CMPS m64, m64 NP I, I E.DF ESI rsi EDI rdi E.CF E.OF E.SF E.ZF E.AF E.PF V NE cmps Compares quadword at address (R|E)SI with quadword at address (R|E)DI and sets the status flags accordingly. +A6 CMPSB NP E.DF ESI rsi EDI rdi E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpsb For legacy mode, compare byte at address DS:(E)SI with byte at address ES:(E)DI; For 64- bit mode compare byte at address (R|E)SI with byte at address (R|E)DI. The status flags are set accordingly. +PREF.66+ A7 CMPSW NP E.DF ESI rsi EDI rdi E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpsw For legacy mode, compare word at address DS:(E)SI with word at address ES:(E)DI; For 64- bit mode compare word at address (R|E)SI with word at address (R|E)DI. The status flags are set accordingly. +A7 CMPSD NP E.DF ESI rsi EDI rdi E.CF E.OF E.SF E.ZF E.AF E.PF V V cmpsl For legacy mode, compare dword at address DS:(E)SI with dword at address ES:(E)DI; For 64-bit mode compare dword at address (R|E)SI with dword at address (R|E)DI. The status flags are set accordingly. +REX.W+ A7 CMPSQ NP E.DF ESI rsi EDI rdi E.CF E.OF E.SF E.ZF E.AF E.PF V NE cmpsq Compares quadword at address (R|E)SI with quadword at address (R|E)DI and sets the status flags accordingly. + +F2 0F C2 /r ib CMPSD xmm1, xmm2/m64, imm8 RMI RW, R, R V V SSE2 cmpsd Compare low double-precision floating-point value in xmm2/m64 and xmm1 using imm8 as comparison predicate. +VEX.NDS.LIG.F2.0F.WIG C2 /r ib VCMPSD xmm1, xmm2, xmm3/m64, imm8 RVMI Z, R, R, R V V AVX vcmpsd Compare low double precision floating-point value in xmm3/m64 and xmm2 using bits 4:0 of imm8 as comparison predicate. + +F3 0F C2 /r ib CMPSS xmm1, xmm2/m32, imm8 RMI RW, R, R V V SSE cmpss Compare low single-precision floating-point value in xmm2/m32 and xmm1 using imm8 as comparison predicate. +VEX.NDS.LIG.F3.0F.WIG C2 /r ib VCMPSS xmm1, xmm2, xmm3/m32, imm8 RVMI Z, R, R, R V V AVX vcmpss Compare low single precision floating-point value in xmm3/m32 and xmm2 using bits 4:0 of imm8 as comparison predicate. + +0F B0 /r CMPXCHG r/m8, r8 MR Rw, R AL al E.ZF E.CF E.PF E.AF E.SF E.OF V V cmpxchgb Compare AL with r/m8. If equal, ZF is set and r8 is loaded into r/m8. Else, clear ZF and load r/m8 into AL. +REX+ 0F B0 /r CMPXCHG r/m8,r8 MR Rw, R AL al E.ZF E.CF E.PF E.AF E.SF E.OF V NE cmpxchgb Compare AL with r/m8. If equal, ZF is set and r8 is loaded into r/m8. Else, clear ZF and load r/m8 into AL. +0F B1 /r CMPXCHG r/m16, r16 MR Rw, R AX ax E.ZF E.CF E.PF E.AF E.SF E.OF V V cmpxchgw Compare AX with r/m16. If equal, ZF is set and r16 is loaded into r/m16. Else, clear ZF and load r/m16 into AX. +0F B1 /r CMPXCHG r/m32, r32 MR Rz, R EAX rax E.ZF E.CF E.PF E.AF E.SF E.OF V V cmpxchgl Compare EAX with r/m32. If equal, ZF is set and r32 is loaded into r/m32. Else, clear ZF and load r/m32 into EAX. +REX.W+ 0F B1 /r CMPXCHG r/m64, r64 MR Rw, R RAX Rax E.ZF E.CF E.PF E.AF E.SF E.OF V NE cmpxchgq Compare RAX with r/m64. If equal, ZF is set and r64 is loaded into r/m64. Else, clear ZF and load r/m64 into RAX. + +0F C7 /1 CMPXCHG8B m64 M Rw EAX EDX rax rbx rcx rdx E.ZF V V CX8 cmpxchg8b Compare EDX:EAX with m64. If equal, set ZF and load ECX:EBX into m64. Else, clear ZF and load m64 into EDX:EAX. +REX.W+ 0F C7 /1 CMPXCHG16B m128 M Rw RAX RDX rax rbx rcx rdx E.ZF V NE CX16 cmpxchg16b Compare RDX:RAX with m128. If equal, set ZF and load RCX:RBX into m128. Else, clear ZF and load m128 into RDX:RAX. + +66 0F 2F /r COMISD xmm1, xmm2/m64 RM R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V SSE2 comisd Compare low double-precision floating-point values in xmm1 and xmm2/mem64 and set the EFLAGS flags accordingly. +VEX.LIG.66.0F.WIG 2F /r VCOMISD xmm1, xmm2/m64 RM R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V AVX vcomisd Compare low double precision floating-point values in xmm1 and xmm2/mem64 and set the EFLAGS flags accordingly. + +0F 2F /r COMISS xmm1, xmm2/m32 RM R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V SSE comiss Compare low single-precision floating-point values in xmm1 and xmm2/mem32 and set the EFLAGS flags accordingly. +VEX.LIG.0F.WIG 2F /r VCOMISS xmm1, xmm2/m32 RM R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V AVX vcomiss Compare low single precision floating-point values in xmm1 and xmm2/mem32 and set the EFLAGS flags accordingly. + +0F A2 CPUID NP EAX ecx RAX RBX RCX RDX V V cpuid Returns processor identification and feature information to the EAX, EBX, ECX, and EDX registers, as determined by input entered in EAX (in some cases, ECX as well). + +F2 0F 38 F0 /r CRC32 r32, r/m8 RM RW, R V V crc32b Accumulate CRC32 on r/m8. +F2 REX+ 0F 38 F0 /r CRC32 r32, r/m8 RM RW, R V NE crc32b Accumulate CRC32 on r/m8. +F2 0F 38 F1 /r CRC32 r32, r/m16 RM RW, R V V crc32w Accumulate CRC32 on r/m16. +F2 0F 38 F1 /r CRC32 r32, r/m32 RM RW, R V V crc32l Accumulate CRC32 on r/m32. +F2 REX.W+ 0F 38 F0 /r CRC32 r64, r/m8 RM RW, R V NE crc32b Accumulate CRC32 on r/m8. +F2 REX.W+ 0F 38 F1 /r CRC32 r64, r/m64 RM RW, R V NE crc32q Accumulate CRC32 on r/m64. + +F3 0F E6 CVTDQ2PD xmm1, xmm2/m64 RM W, R V V SSE2 cvtdq2pd Convert two packed signed doubleword integers from xmm2/m128 to two packed double-precision floating-point values in xmm1. +VEX.128.F3.0F.WIG E6 /r VCVTDQ2PD xmm1, xmm2/m64 RM Z, R V V AVX vcvtdq2pd Convert two packed signed doubleword integers from xmm2/mem to two packed double-precision floating-point values in xmm1. +VEX.256.F3.0F.WIG E6 /r VCVTDQ2PD ymm1, xmm2/m128 RM W, R V V AVX vcvtdq2pd Convert four packed signed doubleword integers from ymm2/mem to four packed double-precision floating-point values in ymm1. + +0F 5B /r CVTDQ2PS xmm1, xmm2/m128 RM W, R V V SSE2 cvtdq2ps Convert four packed signed doubleword integers from xmm2/m128 to four packed single-precision floating-point values in xmm1. +VEX.128.0F.WIG 5B /r VCVTDQ2PS xmm1, xmm2/m128 RM Z, R V V AVX vcvtdq2ps Convert four packed signed doubleword integers from xmm2/mem to four packed single-precision floating-point values in xmm1. +VEX.256.0F.WIG 5B /r VCVTDQ2PS ymm1, ymm2/m256 RM W, R V V AVX vcvtdq2ps Convert eight packed signed doubleword integers from ymm2/mem to eight packed single-precision floating-point values in ymm1. + +F2 0F E6 CVTPD2DQ xmm1, xmm2/m128 RM W, R M.RC V V SSE2 cvtpd2dq Convert two packed double-precision floating- point values from xmm2/m128 to two packed signed doubleword integers in xmm1. +VEX.128.F2.0F.WIG E6 /r VCVTPD2DQ xmm1, xmm2/m128 RM Z, R M.RC V V AVX vcvtpd2dq Convert two packed double-precision floating- point values in xmm2/mem to two signed doubleword integers in xmm1. +VEX.256.F2.0F.WIG E6 /r VCVTPD2DQ xmm1, ymm2/m256 RM Z, R M.RC V V AVX vcvtpd2dq Convert four packed double-precision floating- point values in ymm2/mem to four signed doubleword integers in xmm1. + +66 0F 2D /r CVTPD2PI mm, xmm/m128 RM W, R M.RC V V cvtpd2pi Convert two packed double-precision floating- point values from xmm/m128 to two packed signed doubleword integers in mm. + +66 0F 5A /r CVTPD2PS xmm1, xmm2/m128 RM W, R M.RC V V SSE2 cvtpd2ps Convert two packed double-precision floating- point values in xmm2/m128 to two packed single-precision floating-point values in xmm1. +VEX.128.66.0F.WIG 5A /r VCVTPD2PS xmm1, xmm2/m128 RM Z, R M.RC V V AVX vcvtpd2ps Convert two packed double-precision floating- point values in xmm2/mem to two single- precision floating-point values in xmm1. +VEX.256.66.0F.WIG 5A /r VCVTPD2PS xmm1, ymm2/m256 RM Z, R M.RC V V AVX vcvtpd2ps Convert four packed double-precision floating- point values in ymm2/mem to four single- precision floating-point values in xmm1. + +66 0F 2A /r CVTPI2PD xmm, mm/m64 RM W, R M.RC V V cvtpi2pd Convert two packed signed doubleword integers from mm/mem64 to two packed double-precision floating-point values in xmm. + +0F 2A /r CVTPI2PS xmm, mm/m64 RM RW, R M.RC V V cvtpi2ps Convert two signed doubleword integers from mm/m64 to two single-precision floating-point values in xmm. + +66 0F 5B /r CVTPS2DQ xmm1, xmm2/m128 RM W, R M.RC V V SSE2 cvtps2dq Convert four packed single-precision floating- point values from xmm2/m128 to four packed signed doubleword integers in xmm1. +VEX.128.66.0F.WIG 5B /r VCVTPS2DQ xmm1, xmm2/m128 RM Z, R M.RC V V AVX vcvtps2dq Convert four packed single precision floating- point values from xmm2/mem to four packed signed doubleword values in xmm1. +VEX.256.66.0F.WIG 5B /r VCVTPS2DQ ymm1, ymm2/m256 RM W, R M.RC V V AVX vcvtps2dq Convert eight packed single precision floating- point values from ymm2/mem to eight packed signed doubleword values in ymm1. + +0F 5A /r CVTPS2PD xmm1, xmm2/m64 RM W, R M.RC V V SSE2 cvtps2pd Convert two packed single-precision floating- point values in xmm2/m64 to two packed double-precision floating-point values in xmm1. +VEX.128.0F.WIG 5A /r VCVTPS2PD xmm1, xmm2/m64 RM Z, R M.RC V V AVX vcvtps2pd Convert two packed single-precision floating- point values in xmm2/mem to two packed double-precision floating-point values in xmm1. +VEX.256.0F.WIG 5A /r VCVTPS2PD ymm1, xmm2/m128 RM W, R M.RC V V AVX vcvtps2pd Convert four packed single-precision floating- point values in xmm2/mem to four packed double-precision floating-point values in ymm1. + +0F 2D /r CVTPS2PI mm, xmm/m64 RM W, R M.RC V V cvtps2pi Convert two packed single-precision floating- point values from xmm/m64 to two packed signed doubleword integers in mm. + +F2 0F 2D /r CVTSD2SI r32, xmm/m64 RM W, R M.RC V V SSE2 cvtsd2si Convert one double-precision floating-point value from xmm/m64 to one signed doubleword integer r32. +F2 REX.W+ 0F 2D /r CVTSD2SI r64, xmm/m64 RM W, R M.RC V NE SSE2 cvtsd2si Convert one double-precision floating-point value from xmm/m64 to one signed quadword integer sign-extended into r64. +VEX.LIG.F2.0F.W0 2D /r VCVTSD2SI r32, xmm1/m64 RM W, R M.RC V V AVX vcvtsd2si Convert one double precision floating-point value from xmm1/m64 to one signed doubleword integer r32. +VEX.LIG.F2.0F.W1 2D /r VCVTSD2SI r64, xmm1/m64 RM W, R M.RC V NE AVX vcvtsd2si Convert one double precision floating-point value from xmm1/m64 to one signed quadword integer sign-extended into r64. + +F2 0F 5A /r CVTSD2SS xmm1, xmm2/m64 RM RW, R M.RC V V SSE2 cvtsd2ss Convert one double-precision floating-point value in xmm2/m64 to one single-precision floating-point value in xmm1. +VEX.NDS.LIG.F2.0F.WIG 5A /r VCVTSD2SS xmm1,xmm2, xmm3/m64 RVM Z, R, R M.RC V V AVX vcvtsd2ss Convert one double-precision floating-point value in xmm3/m64 to one single-precision floating-point value and merge with high bits in xmm2. + +F2 0F 2A /r CVTSI2SD xmm, r/m32 RM RW, R M.RC V V SSE2 cvtsi2sdl Convert one signed doubleword integer from r/m32 to one double-precision floating-point value in xmm. +F2 REX.W+ 0F 2A /r CVTSI2SD xmm, r/m64 RM RW, R M.RC V NE SSE2 cvtsi2sdq Convert one signed quadword integer from r/m64 to one double-precision floating-point value in xmm. +VEX.NDS.LIG.F2.0F.W0 2A /r VCVTSI2SD xmm1, xmm2, r/m32 RVM Z, R, R M.RC V V AVX vcvtsi2sdl Convert one signed doubleword integer from r/m32 to one double-precision floating-point value in xmm1. +VEX.NDS.LIG.F2.0F.W1 2A /r VCVTSI2SD xmm1, xmm2, r/m64 RVM Z, R, R M.RC V NE AVX vcvtsi2sdq Convert one signed quadword integer from r/m64 to one double-precision floating-point value in xmm1. + +F3 0F 2A /r CVTSI2SS xmm, r/m32 RM RW, R M.RC V V SSE cvtsi2ssl Convert one signed doubleword integer from r/m32 to one single-precision floating-point value in xmm. +F3 REX.W+ 0F 2A /r CVTSI2SS xmm, r/m64 RM RW, R M.RC V NE SSE cvtsi2ssq Convert one signed quadword integer from r/m64 to one single-precision floating-point value in xmm. +VEX.NDS.LIG.F3.0F.W0 2A /r VCVTSI2SS xmm1, xmm2, r/m32 RVM Z, R, R M.RC V V AVX vcvtsi2ssl Convert one signed doubleword integer from r/m32 to one single-precision floating-point value in xmm1. +VEX.NDS.LIG.F3.0F.W1 2A /r VCVTSI2SS xmm1, xmm2, r/m64 RVM Z, R, R M.RC V NE AVX vcvtsi2ssq Convert one signed quadword integer from r/m64 to one single-precision floating-point value in xmm1. + +F3 0F 5A /r CVTSS2SD xmm1, xmm2/m32 RM RW, R M.RC V V SSE2 cvtss2sd Convert one single-precision floating-point value in xmm2/m32 to one double-precision floating-point value in xmm1. +VEX.NDS.LIG.F3.0F.WIG 5A /r VCVTSS2SD xmm1, xmm2, xmm3/m32 RVM Z, R, R M.RC V V AVX vcvtss2sd Convert one single-precision floating-point value in xmm3/m32 to one double-precision floating-point value and merge with high bits of xmm2. + +F3 0F 2D /r CVTSS2SI r32, xmm/m32 RM W, R V V SSE cvtss2si Convert one single-precision floating-point value from xmm/m32 to one signed doubleword integer in r32. +F3 REX.W+ 0F 2D /r CVTSS2SI r64, xmm/m32 RM W, R V NE SSE cvtss2si Convert one single-precision floating-point value from xmm/m32 to one signed quadword integer in r64. +VEX.LIG.F3.0F.W0 2D /r VCVTSS2SI r32, xmm1/m32 RM W, R V V AVX vcvtss2si Convert one single-precision floating-point value from xmm1/m32 to one signed doubleword integer in r32. +VEX.LIG.F3.0F.W1 2D /r VCVTSS2SI r64, xmm1/m32 RM W, R V NE AVX vcvtss2si Convert one single-precision floating-point value from xmm1/m32 to one signed quadword integer in r64. + +66 0F E6 CVTTPD2DQ xmm1, xmm2/m128 RM W, R V V SSE2 cvttpd2dq Convert two packed double-precision floating- point values from xmm2/m128 to two packed signed doubleword integers in xmm1 using truncation. +VEX.128.66.0F.WIG E6 /r VCVTTPD2DQ xmm1, xmm2/m128 RM Z, R V V AVX vcvttpd2dq Convert two packed double-precision floating- point values in xmm2/mem to two signed doubleword integers in xmm1 using truncation. +VEX.256.66.0F.WIG E6 /r VCVTTPD2DQ xmm1, ymm2/m256 RM Z, R V V AVX vcvttpd2dq Convert four packed double-precision floating- point values in ymm2/mem to four signed doubleword integers in xmm1 using truncation. + +66 0F 2C /r CVTTPD2PI mm, xmm/m128 RM W, R V V cvttpd2pi Convert two packer double-precision floating- point values from xmm/m128 to two packed signed doubleword integers in mm using truncation. + +F3 0F 5B /r CVTTPS2DQ xmm1, xmm2/m128 RM W, R V V SSE2 cvttps2dq Convert four single-precision floating-point values from xmm2/m128 to four signed doubleword integers in xmm1 using truncation. +VEX.128.F3.0F.WIG 5B /r VCVTTPS2DQ xmm1, xmm2/m128 RM Z, R V V AVX vcvttps2dq Convert four packed single precision floating- point values from xmm2/mem to four packed signed doubleword values in xmm1 using truncation. +VEX.256.F3.0F.WIG 5B /r VCVTTPS2DQ ymm1, ymm2/m256 RM W, R V V AVX vcvttps2dq Convert eight packed single precision floating- point values from ymm2/mem to eight packed signed doubleword values in ymm1 using truncation. + +0F 2C /r CVTTPS2PI mm, xmm/m64 RM W, R V V cvttps2pi Convert two single-precision floating-point values from xmm/m64 to two signed doubleword signed integers in mm using truncation. + +F2 0F 2C /r CVTTSD2SI r32, xmm/m64 RM W, R V V SSE2 cvttsd2si Convert one double-precision floating-point value from xmm/m64 to one signed doubleword integer in r32 using truncation. +F2 REX.W+ 0F 2C /r CVTTSD2SI r64, xmm/m64 RM W, R V NE SSE2 cvttsd2si Convert one double precision floating-point value from xmm/m64 to one signedquadword integer in r64 using truncation. +VEX.LIG.F2.0F.W0 2C /r VCVTTSD2SI r32, xmm1/m64 RM W, R V V AVX vcvttsd2si Convert one double-precision floating-point value from xmm1/m64 to one signed doubleword integer in r32 using truncation. +VEX.LIG.F2.0F.W1 2C /r VCVTTSD2SI r64, xmm1/m64 RM W, R V NE AVX vcvttsd2si Convert one double precision floating-point value from xmm1/m64 to one signed quadword integer in r64 using truncation. + +F3 0F 2C /r CVTTSS2SI r32, xmm/m32 RM W, R V V SSE cvttss2si Convert one single-precision floating-point value from xmm/m32 to one signed doubleword integer in r32 using truncation. +F3 REX.W+ 0F 2C /r CVTTSS2SI r64, xmm/m32 RM W, R V NE SSE cvttss2si Convert one single-precision floating-point value from xmm/m32 to one signed quadword integer in r64 using truncation. +VEX.LIG.F3.0F.W0 2C /r VCVTTSS2SI r32, xmm1/m32 RM W, R V V AVX vcvttss2si Convert one single-precision floating-point value from xmm1/m32 to one signed doubleword integer in r32 using truncation. +VEX.LIG.F3.0F.W1 2C /r VCVTTSS2SI r64, xmm1/m32 RM W, R V NE AVX vcvttss2si Convert one single-precision floating-point value from xmm1/m32 to one signed quadword integer in r64 using truncation. + +PREF.66+ 99 CWD NP AX DX V V cwtd DX:AX = sign-extend of AX. +99 CDQ NP EAX RDX V V cltd EDX:EAX = sign-extend of EAX. +REX.W+ 99 CQO NP RAX RDX V NE cqto RDX:RAX = sign-extend of RAX. + +27 DAA I V Decimal adjust AL after addition. + +2F DAS I V Decimal adjust AL after subtraction. + +FE /1 DEC r/m8 M RW E.OF E.SF E.ZF E.AF E.PF V V decb Decrement r/m8 by 1. +REX+ FE /1 DEC r/m8 M RW E.OF E.SF E.ZF E.AF E.PF V NE decb Decrement r/m8 by 1. +FF /1 DEC r/m16 M RW E.OF E.SF E.ZF E.AF E.PF V V decw Decrement r/m16 by 1. +FF /1 DEC r/m32 M RW E.OF E.SF E.ZF E.AF E.PF V V decl Decrement r/m32 by 1. +REX.W+ FF /1 DEC r/m64 M RW E.OF E.SF E.ZF E.AF E.PF V NE decq Decrement r/m64 by 1. +48 +rw DEC r16 NE V Decrement r16 by 1. +48 +rd DEC r32 NE V Decrement r32 by 1. + +F6 /6 DIV r/m8 M R AX AX E.CF E.OF E.SF E.ZF E.AF E.PF V V divb Unsigned divide AX by r/m8, with result stored in AL = Quotient, AH = Remainder. +REX+ F6 /6 DIV r/m8 M R AX AX E.CF E.OF E.SF E.ZF E.AF E.PF V NE divb Unsigned divide AX by r/m8, with result stored in AL = Quotient, AH = Remainder. +F7 /6 DIV r/m16 M R AX DX AX DX E.CF E.OF E.SF E.ZF E.AF E.PF V V divw Unsigned divide DX:AX by r/m16, with result stored in AX = Quotient, DX = Remainder. +F7 /6 DIV r/m32 M R EAX EDX RAX RDX E.CF E.OF E.SF E.ZF E.AF E.PF V V divl Unsigned divide EDX:EAX by r/m32, with result stored in EAX = Quotient, EDX = Remainder. +REX.W+ F7 /6 DIV r/m64 M R RAX RDX RAX RDX E.CF E.OF E.SF E.ZF E.AF E.PF V NE divq Unsigned divide RDX:RAX by r/m64, with result stored in RAX = Quotient, RDX = Remainder. + +66 0F 5E /r DIVPD xmm1, xmm2/m128 RM RW, R V V SSE2 divpd Divide packed double-precision floating-point values in xmm1 by packed double-precision floating-point values xmm2/m128. +VEX.NDS.128.66.0F.WIG 5E /r VDIVPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vdivpd Divide packed double-precision floating-point values in xmm2 by packed double-precision floating-point values in xmm3/mem. +VEX.NDS.256.66.0F.WIG 5E /r VDIVPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vdivpd Divide packed double-precision floating-point values in ymm2 by packed double-precision floating-point values in ymm3/mem. + +0F 5E /r DIVPS xmm1, xmm2/m128 RM RW, R V V SSE divps Divide packed single-precision floating-point values in xmm1 by packed single-precision floating-point values xmm2/m128. +VEX.NDS.128.0F.WIG 5E /r VDIVPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vdivps Divide packed single-precision floating-point values in xmm2 by packed double-precision floating-point values in xmm3/mem. +VEX.NDS.256.0F.WIG 5E /r VDIVPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vdivps Divide packed single-precision floating-point values in ymm2 by packed double-precision floating-point values in ymm3/mem. + +F2 0F 5E /r DIVSD xmm1, xmm2/m64 RM RW, R V V SSE2 divsd Divide low double-precision floating-point value in xmm1 by low double-precision floating-point value in xmm2/mem64. +VEX.NDS.LIG.F2.0F.WIG 5E /r VDIVSD xmm1, xmm2, xmm3/m64 RVM Z, R, R V V AVX vdivsd Divide low double-precision floating point values in xmm2 by low double precision floating-point value in xmm3/mem64. + +F3 0F 5E /r DIVSS xmm1, xmm2/m32 RM RW, R V V SSE divss Divide low single-precision floating-point value in xmm1 by low single-precision floating-point value in xmm2/m32. +VEX.NDS.LIG.F3.0F.WIG 5E /r VDIVSS xmm1, xmm2, xmm3/m32 RVM Z, R, R V V AVX vdivss Divide low single-precision floating point value in xmm2 by low single precision floating-point value in xmm3/m32. + +66 0F 3A 41 /r ib DPPD xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSE4_1 dppd Selectively multiply packed DP floating-point values from xmm1 with packed DP floating- point values from xmm2, add and selectively store the packed DP floating-point values to xmm1. +VEX.NDS.128.66.0F3A.WIG 41 /r ib VDPPD xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vdppd Selectively multiply packed DP floating-point values from xmm2 with packed DP floating- point values from xmm3, add and selectively store the packed DP floating-point values to xmm1. + +66 0F 3A 40 /r ib DPPS xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSE4_1 dpps Selectively multiply packed SP floating-point values from xmm1 with packed SP floating- point values from xmm2, add and selectively store the packed SP floating-point values or zero values to xmm1. +VEX.NDS.128.66.0F3A.WIG 40 /r ib VDPPS xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vdpps Multiply packed SP floating point values from xmm1 with packed SP floating point values from xmm2/mem selectively add and store to xmm1. +VEX.NDS.256.66.0F3A.WIG 40 /r ib VDPPS ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX vdpps Multiply packed single-precision floating-point values from ymm2 with packed SP floating point values from ymm3/mem, selectively add pairs of elements and store to ymm1. + +0F 77 EMMS NP TAG(*) V V emms Set the x87 FPU tag word to empty. + +C8 ib iw ENTER 0, imm16 II R, R ??? ??? ??? V V enterq Create a stack frame for a procedure. +C8 ib iw ENTER 1, imm16 II R, R ??? ??? ??? V V enterq Create a nested stack frame for a procedure. +C8 ib iw ENTER imm8, imm16 II R, R ??? ??? ??? V V enterq Create a nested stack frame for a procedure. + +66 0F 3A 17 /r ib EXTRACTPS reg/m32, xmm2, imm8 MRI W, R, R V V SSE4_1 extractps Extract a single-precision floating-point value from xmm2 at the source offset specified by imm8 and store the result to reg or m32. The upper 32 bits of r64 is zeroed if reg is r64. +VEX.128.66.0F3A.WIG 17 /r ib VEXTRACTPS r/m32, xmm1, imm8 MRI W, R, R V V AVX vextractps Extract one single-precision floating-point value from xmm1 at the offset specified by imm8 and store the result in reg or m32. Zero extend the results in 64-bit register if applicable. + +D9 F0 F2XM1 ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU f2xm1 Replace ST(0) with (2^(ST(0)) - 1). + +D9 E1 FABS ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fabs Replace ST with its absolute value. + +D8 /0 FADD m32fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fadds Add m32fp to ST(0) and store result in ST(0). +DC /0 FADD m64fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU faddl Add m64fp to ST(0) and store result in ST(0). +D8 C0 +i FADD ST(0), ST(i) TO RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fadd Add ST(0) to ST(i) and store result in ST(0). +DC C0 +i FADD ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fadd Add ST(i) to ST(0) and store result in ST(i). +DE C0 +i FADDP ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU faddp Add ST(0) to ST(i), store result in ST(i), and pop the register stack. +DE C1 FADDP ST(0) ST(1) ST(1) S.C1 S.C0 S.C2 S.C3 V V FPU faddp Add ST(0) to ST(1), store result in ST(1), and pop the register stack. +DA /0 FIADD m32int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fiaddl Add m32int to ST(0) and store result in ST(0). +DE /0 FIADD m16int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fiadd Add m16int to ST(0) and store result in ST(0). + +DF /4 FBLD m80bcd M R ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fbld Convert BCD value to floating-point and push onto the FPU stack. + +DF /6 FBSTP m80bcd M R ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fbstp Store ST(0) in m80bcd and pop ST(0). + +D9 E0 FCHS ST(0) ST(0) V V FPU fchs Complements sign of ST(0). + +9B DB E2 FCLEX S.PE S.UE S.OE S.ZE S.DE S.IE S.ES S.SF S.B S.C0 S.C1 S.C2 S.C3 V V FPU fclex Clear floating-point exception flags after checking for pending unmasked floating-point exceptions. +DB E2 FNCLEX S.PE S.UE S.OE S.ZE S.DE S.IE S.ES S.SF S.B S.C0 S.C1 S.C2 S.C3 V V FPU fnclex Clear floating-point exception flags without checking for pending unmasked floating-point exceptions. + +DA C0 +i FCMOVB ST(0), ST(i) TO w, R E.CF S.C1 S.C0 S.C2 S.C3 V V FPU CMOV fcmovb Move if below (CF=1). +DA C8 +i FCMOVE ST(0), ST(i) TO w, R E.ZF S.C1 S.C0 S.C2 S.C3 V V FPU CMOV fcmove Move if equal (ZF=1). +DA D0 +i FCMOVBE ST(0), ST(i) TO w, R E.CF E.ZF S.C1 S.C0 S.C2 S.C3 V V FPU CMOV fcmovbe Move if below or equal (CF=1 or ZF=1). +DA D8 +i FCMOVU ST(0), ST(i) TO w, R E.PF S.C1 S.C0 S.C2 S.C3 V V FPU CMOV fcmovu Move if unordered (PF=1). +DB C0 +i FCMOVNB ST(0), ST(i) TO w, R E.CF S.C1 S.C0 S.C2 S.C3 V V FPU CMOV fcmovnb Move if not below (CF=0). +DB C8 +i FCMOVNE ST(0), ST(i) TO w, R E.ZF S.C1 S.C0 S.C2 S.C3 V V FPU CMOV fcmovne Move if not equal (ZF=0). +DB D0 +i FCMOVNBE ST(0), ST(i) TO w, R E.CF S.C1 S.C0 S.C2 S.C3 V V FPU CMOV fcmovnbe Move if not below or equal (CF=0 and ZF=0). +DB D8 +i FCMOVNU ST(0), ST(i) TO w, R E.PF S.C1 S.C0 S.C2 S.C3 V V FPU CMOV fcmovnu Move if not unordered (PF=0). + +D8 /2 FCOM m32fp M R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fcoms Compare ST(0) with m32fp. +DC /2 FCOM m64fp M R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fcoml Compare ST(0) with m64fp. +D8 D0 +i FCOM ST(i) O R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fcom Compare ST(0) with ST(i). +D8 D1 FCOM ST(0) ST(1) S.C0 S.C1 S.C2 S.C3 V V FPU fcom Compare ST(0) with ST(1). +D8 /3 FCOMP m32fp M R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fcomps Compare ST(0) with m32fp and pop register stack. +DC /3 FCOMP m64fp M R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fcompl Compare ST(0) with m64fp and pop register stack. +D8 D8 +i FCOMP ST(i) O R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fcomp Compare ST(0) with ST(i) and pop register stack. +D8 D9 FCOMP ST(0) ST(1) S.C0 S.C1 S.C2 S.C3 V V FPU fcomp Compare ST(0) with ST(1) and pop register stack. +DE D9 FCOMPP ST(0) ST(1) S.C0 S.C1 S.C2 S.C3 V V FPU fcompp Compare ST(0) with ST(1) and pop register stack twice. + +DB F0 +i FCOMI ST, ST(i) TO R, R E.CF E.OF E.SF E.ZF E.AF E.PF S.C1 V V FPU fcomi Compare ST(0) with ST(i) and set status flags accordingly. +DF F0 +i FCOMIP ST, ST(i) TO R, R E.CF E.OF E.SF E.ZF E.AF E.PF S.C1 V V FPU fcomip Compare ST(0) with ST(i), set status flags accordingly, and pop register stack. +DB E8 +i FUCOMI ST, ST(i) TO R, R E.CF E.OF E.SF E.ZF E.AF E.PF S.C1 V V FPU fucomi Compare ST(0) with ST(i), check for ordered values, and set status flags accordingly. +DF E8 +i FUCOMIP ST, ST(i) TO R, R E.CF E.OF E.SF E.ZF E.AF E.PF S.C1 V V FPU fucomip Compare ST(0) with ST(i), check for ordered values, set status flags accordingly, and pop register stack. + +D9 FF FCOS ST(0) ST(0) s.c1 S.C2 s.c1 S.C0 S.C3 V V FPU fcos Replace ST(0) with its cosine. + +D9 F6 FDECSTP S.TOP S.TOP S.C1 S.C0 S.C2 S.C3 V V FPU fdecstp Decrement TOP field in FPU status word. + +D8 /6 FDIV m32fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fdivs Divide ST(0) by m32fp and store result in ST(0). +DC /6 FDIV m64fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fdivl Compare ST(0) with ST(i), set status flags accordingly, and pop register stack. +D8 F0 +i FDIV ST(0), ST(i) TO RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fdiv Divide ST(0) by ST(i) and store result in ST(0). +DC F0 +i FDIV ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fdiv Divide ST(i) by ST(0) and store result in ST(i). +DE F0 +i FDIVP ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fdivp Divide ST(i) by ST(0), store result in ST(i), and pop the register stack. +DE F1 FDIVP ST(0) ST(1) ST(1) S.C1 S.C0 S.C2 S.C3 V V FPU fdivp Divide ST(1) by ST(0), store result in ST(1), and pop the register stack. +DA /6 FIDIV m32int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fidivl Divide ST(0) by m32int and store result in ST(0). +DE /6 FIDIV m16int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fidiv Divide ST(0) by m64int and store result in ST(0). + +D8 /7 FDIVR m32fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fdivrs Divide m32fp by ST(0) and store result in ST(0). +DC /7 FDIVR m64fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fdivrl Divide m64fp by ST(0) and store result in ST(0). +D8 F8 +i FDIVR ST(0), ST(i) TO RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fdivr Divide ST(i) by ST(0) and store result in ST(0). +DC F8 +i FDIVR ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fdivr Divide ST(0) by ST(i) and store result in ST(i). +DE F8 +i FDIVRP ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fdivrp Divide ST(0) by ST(i), store result in ST(i), and pop the register stack. +DE F9 FDIVRP ST(0) ST(1) ST(1) S.C1 S.C0 S.C2 S.C3 V V FPU fdivrp Divide ST(0) by ST(1), store result in ST(1), and pop the register stack. +DA /7 FIDIVR m32int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fidivrl Divide m32int by ST(0) and store result in ST(0). +DE /7 FIDIVR m16int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fidivr Divide m16int by ST(0) and store result in ST(0). + +DD C0 +i FFREE ST(i) O I S.C0 S.C1 s.c2 S.C3 V V FPU ffreep Sets tag for ST(i) to empty. + +DE /2 FICOM m16int M R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU ficom Compare ST(0) with m16int. +DA /2 FICOM m32int M R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU ficoml Compare ST(0) with m32int. +DE /3 FICOMP m16int M R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU ficomp Compare ST(0) with m16int and pop stack register. +DA /3 FICOMP m32int M R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU ficompl Compare ST(0) with m32int and pop stack register. + +DF /0 FILD m16int M R ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fild Push m16int onto the FPU register stack. +DB /0 FILD m32int M R ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fildl Push m32int onto the FPU register stack. +DF /5 FILD m64int M R ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fildll Push m64int onto the FPU register stack. + +D9 F7 FINCSTP S.TOP S.TOP S.C1 S.C0 S.C2 S.C3 V V FPU fincstp Increment the TOP field in the FPU status register. + +9B DB E3 FINIT S.* TAG(*) FPUDATA FPUINSTR FPUOPCODE V V FPU finit Initialize FPU after checking for pending unmasked floating-point exceptions. +DB E3 FNINIT S.* TAG(*) FPUDATA FPUINSTR FPUOPCODE V V FPU fninit Initialize FPU without checking for pending unmasked floating-point exceptions. + +DF /2 FIST m16int M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fist Store ST(0) in m16int. +DB /2 FIST m32int M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fistl Store ST(0) in m32int. +DF /3 FISTP m16int M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fistp Store ST(0) in m16int and pop register stack. +DB /3 FISTP m32int M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fistpl Store ST(0) in m32int and pop register stack. +DF /7 FISTP m64int M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fistpll Store ST(0) in m64int and pop register stack. + +DF /1 FISTTP m16int M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fisttp Store ST(0) in m16int with truncation. +DB /1 FISTTP m32int M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fisttpl Store ST(0) in m32int with truncation. +DD /1 FISTTP m64int M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fisttpll Store ST(0) in m64int with truncation. + +D9 /0 FLD m32fp M R ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU flds Push m32fp onto the FPU register stack. +DD /0 FLD m64fp M R ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fldl Push m64fp onto the FPU register stack. +DB /5 FLD m80fp M R ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fldt Push m80fp onto the FPU register stack. +D9 C0 +i FLD ST(i) O R ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fld Push ST(i) onto the FPU register stack. + +D9 E8 FLD1 ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fld1 Push +1.0 onto the FPU register stack. +D9 E9 FLDL2T ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fldl2t Push log210 onto the FPU register stack. +D9 EA FLDL2E ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fldl2e Push log2e onto the FPU register stack. +D9 EB FLDPI ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fldpi Push pi onto the FPU register stack. +D9 EC FLDLG2 ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fldlg2 Push log102 onto the FPU register stack. +D9 ED FLDLN2 ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fldln2 Push loge2 onto the FPU register stack. +D9 EE FLDZ ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fldz Push +0.0 onto the FPU register stack. + +D9 /5 FLDCW m2byte M R S.C0 S.C1 S.C2 S.C3 V V FPU fldcw Load FPU control word from m2byte. + +D9 /4 FLDENV m28byte M R S.* TAG(*) FPUDATA FPUINSTR FPUOPCODE V V FPU fldenvl Load FPU environment from m14byte or m28byte. + +D8 /1 FMUL m32fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fmuls Multiply ST(0) by m32fp and store result in ST(0). +DC /1 FMUL m64fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fmull Multiply ST(0) by m64fp and store result in ST(0). +D8 C8 +i FMUL ST(0), ST(i) TO RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fmul Multiply ST(0) by ST(i) and store result in ST(0). +DC C8 +i FMUL ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fmul Multiply ST(i) by ST(0) and store result in ST(i). +DE C8 +i FMULP ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fmulp Multiply ST(i) by ST(0), store result in ST(i), and pop the register stack. +DE C9 FMULP ST(0) ST(1) ST(1) S.C1 S.C0 S.C2 S.C3 V V FPU fmulp Multiply ST(1) by ST(0), store result in ST(1), and pop the register stack. +DA /1 FIMUL m32int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fimull Multiply ST(0) by m32int and store result in ST(0). +DE /1 FIMUL m16int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fimul Multiply ST(0) by m16int and store result in ST(0). + +D9 D0 FNOP S.C0 S.C1 S.C2 S.C3 V V FPU fnop No operation is performed. + +D9 F3 FPATAN ST(0) ST(1) ST(1) S.C1 S.C0 S.C2 S.C3 V V FPU fpatan Replace ST(1) with arctan(ST(1)/ST(0)) and pop the register stack. + +D9 F8 FPREM ST(0) ST(1) ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fprem Replace ST(0) with the remainder obtained from dividing ST(0) by ST(1). + +D9 F5 FPREM1 ST(0) ST(1) ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fprem1 Replace ST(0) with the IEEE remainder obtained from dividing ST(0) by ST(1). + +D9 F2 FPTAN ST(0) ST(0) S.C1 S.C2 S.C0 S.C3 V V FPU fptan Replace ST(0) with its tangent and push 1 onto the FPU stack. + +D9 FC FRNDINT ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU frndint Round ST(0) to an integer. + +DD /4 FRSTOR m108byte M R ST(*) TAG(*) FPUDATA FPUINSTR S.* M.* V V FPU frstor Load FPU state from m94byte or m108byte. + +9B DD /6 FSAVE m108byte M W ST(*) S.* FPUDATA FPUINSTR FPUOPCODE ST(*) TAG(*) S.* FPUDATA FPUINSTR FPUOPCODE V V FPU fsave Store FPU state to m94byte or m108byte after checking for pending unmasked floating-point exceptions. Then re-initialize the FPU. +DD /6 FNSAVE m108byte M W ST(*) S.* FPUDATA FPUINSTR FPUOPCODE ST(*) TAG(*) S.* FPUDATA FPUINSTR FPUOPCODE V V FPU fnsave Store FPU environment to m94byte or m108byte without checking for pending unmasked floating-point exceptions. Then re-initialize the FPU. + +D9 FD FSCALE ST(0) ST(1) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fscale Scale ST(0) by ST(1). + +D9 FE FSIN ST(0) ST(0) S.C1 S.C2 S.C0 S.C3 V V FPU fsin Replace ST(0) with its sine. + +D9 FB FSINCOS ST(0) ST(0) S.C1 S.C2 S.C0 S.C3 V V FPU fsincos Compute the sine and cosine of ST(0); replace ST(0) with the sine, and push the cosine onto the register stack. + +D9 FA FSQRT ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fsqrt Computes square root of ST(0) and stores the result in ST(0). + +D9 /2 FST m32fp M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fsts Copy ST(0) to m32fp. +DD /2 FST m64fp M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fstl Copy ST(0) to m64fp. +DD D0 +i FST ST(i) O W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fst Copy ST(0) to ST(i). +D9 /3 FSTP m32fp M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fstps Copy ST(0) to m32fp and pop register stack. +DD /3 FSTP m64fp M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fstpl Copy ST(0) to m64fp and pop register stack. +DB /7 FSTP m80fp M W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fstpt Copy ST(0) to m80fp and pop register stack. +DD D8 +i FSTP ST(i) O W ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fstp Copy ST(0) to ST(i) and pop register stack. + +9B D9 /7 FSTCW m2byte M W S.C0 S.C1 S.C2 S.C3 V V FPU fstcw Store FPU control word to m2byte after checking for pending unmasked floating-point exceptions. +D9 /7 FNSTCW m2byte M W S.C0 S.C1 S.C2 S.C3 V V FPU fnstcw Store FPU control word to m2byte without checking for pending unmasked floating-point exceptions. + +9B D9 /6 FSTENV m28byte M W S.* TAG(*) FPUDATA FPUINSTR FPUOPCODE S.C0 S.C1 S.C2 S.C3 V V FPU fstenvl Store FPU environment to m14byte or m28byte after checking for pending unmasked floating-point exceptions. Then mask all floating-point exceptions. +D9 /6 FNSTENV m28byte M W S.* TAG(*) FPUDATA FPUINSTR FPUOPCODE S.C0 S.C1 S.C2 S.C3 V V FPU fnstenvl Store FPU environment to m14byte or m28byte without checking for pending unmasked floating-point exceptions. Then mask all floating-point exceptions. + +9B DD /7 FSTSW m2byte M W S.* S.C0 S.C1 S.C2 S.C3 V V FPU fstsw Store FPU status word at m2byte after checking for pending unmasked floating-point exceptions. +9B DF E0 FSTSW AX W S.* S.C0 S.C1 S.C2 S.C3 V V FPU fstsw Store FPU status word in AX register after checking for pending unmasked floating-point exceptions. +DD /7 FNSTSW m2byte M W S.* S.C0 S.C1 S.C2 S.C3 V V FPU fnstsw Store FPU status word at m2byte without checking for pending unmasked floating-point exceptions. +DF E0 FNSTSW AX W S.* S.C0 S.C1 S.C2 S.C3 V V FPU fnstsw Store FPU status word in AX register without checking for pending unmasked floating-point exceptions. + +D8 /4 FSUB m32fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fsubs Subtract m32fp from ST(0) and store result in ST(0). +DC /4 FSUB m64fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fsubl Subtract m64fp from ST(0) and store result in ST(0). +D8 E0 +i FSUB ST(0), ST(i) TO RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fsub Subtract ST(i) from ST(0) and store result in ST(0). +DC E0 +i FSUB ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fsub Subtract ST(0) from ST(i) and store result in ST(i). +DE E0 +i FSUBP ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fsubp Subtract ST(0) from ST(i), store result in ST(i), and pop register stack. +DE E1 FSUBP ST(0) ST(1) ST(1) S.C1 S.C0 S.C2 S.C3 V V FPU fsubp Subtract ST(0) from ST(1), store result in ST(1), and pop register stack. +DA /4 FISUB m32int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fisubl Subtract m32int from ST(0) and store result in ST(0). +DE /4 FISUB m16int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fisub Subtract m16int from ST(0) and store result in ST(0). + +D8 /5 FSUBR m32fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fsubrs Subtract ST(0) from m32fp and store result in ST(0). +DC /5 FSUBR m64fp M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fsubrl Subtract ST(0) from m64fp and store result in ST(0). +D8 E8 +i FSUBR ST(0), ST(i) TO RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fsubr Subtract ST(0) from ST(i) and store result in ST(0). +DC E8 +i FSUBR ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V FPU fsubr Subtract ST(i) from ST(0) and store result in ST(i). +DE E8 +i FSUBRP ST(i), ST(0) OT RW, R S.C1 S.C0 S.C2 S.C3 V V fsubrp Subtract ST(i) from ST(0), store result in ST(i), and pop register stack. +DE E9 FSUBRP ST(0) ST(1) ST(1) S.C1 S.C0 S.C2 S.C3 V V FPU fsubrp Subtract ST(1) from ST(0), store result in ST(1), and pop register stack. +DA /5 FISUBR m32int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fisubrl Subtract ST(0) from m32int and store result in ST(0). +DE /5 FISUBR m16int M R ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fisubr Subtract ST(0) from m16int and store result in ST(0). + +D9 E4 FTST ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU ftst Compare ST(0) with 0.0. + +DD E0 +i FUCOM ST(i) O R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fucom Compare ST(0) with ST(i). +DD E1 FUCOM ST(0) ST(1) S.C0 S.C1 S.C2 S.C3 V V FPU fucom Compare ST(0) with ST(1). +DD E8 +i FUCOMP ST(i) O R ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fucomp Compare ST(0) with ST(i) and pop register stack. +DD E9 FUCOMP ST(0) ST(1) S.C0 S.C1 S.C2 S.C3 V V FPU fucomp Compare ST(0) with ST(1) and pop register stack. +DA E9 FUCOMPP ST(0) ST(1) S.C0 S.C1 S.C2 S.C3 V V FPU fucompp Compare ST(0) with ST(1) and pop register stack twice. + +D9 E5 FXAM ST(0) S.C0 S.C1 S.C2 S.C3 V V FPU fxam Classify value or number in ST(0). + +D9 C8 +i FXCH ST(i) O RW ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fxch Exchange the contents of ST(0) and ST(i). +D9 C9 FXCH ST(0) ST(1) ST(0) ST(1) S.C1 S.C0 S.C2 S.C3 V V FPU fxch Exchange the contents of ST(0) and ST(1). + +0F AE /1 FXRSTOR m512byte M R ST(*) MM* XMM* CS DS V V FPU FXSR fxrstor Restore the x87 FPU, MMX, XMM, and MXCSR register state from m512byte. +REX.W+ 0F AE /1 FXRSTOR64 m512byte M R ST(*) MM* XMM* V NE FPU FXSR fxrstor64 Restore the x87 FPU, MMX, XMM, and MXCSR register state from m512byte. + +0F AE /0 FXSAVE m512byte M W ST(*) MM* XMM* M.* CS DS V V FPU FXSR fxsave Save the x87 FPU, MMX, XMM, and MXCSR register state to m512byte. +REX.W+ 0F AE /0 FXSAVE64 m512byte M W ST(*) MM* XMM* M.* V NE FPU FXSR fxsave64 Save the x87 FPU, MMX, XMM, and MXCSR register state to m512byte. + +D9 F4 FXTRACT ST(0) ST(0) S.C1 S.C0 S.C2 S.C3 V V FPU fxtract Separate value in ST(0) into exponent and significand, store exponent in ST(0), and push the significand onto the register stack. + +D9 F1 FYL2X ST(0) ST(1) ST(1) S.C1 S.C0 S.C2 S.C3 V V FPU fyl2x Replace ST(1) with (ST(1) * log2ST(0)) and pop the register stack. + +D9 F9 FYL2XP1 ST(0) ST(1) ST(1) S.C1 S.C0 S.C2 S.C3 V V FPU fyl2xp1 Replace ST(1) with ST(1) * log2(ST(0) + 1.0) and pop the register stack. + +66 0F 7C /r HADDPD xmm1, xmm2/m128 RM RW, R V V PNI haddpd Horizontal add packed double-precision floating-point values from xmm2/m128 to xmm1. +VEX.NDS.128.66.0F.WIG 7C /r VHADDPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vhaddpd Horizontal add packed double-precision floating-point values from xmm2 and xmm3/mem. +VEX.NDS.256.66.0F.WIG 7C /r VHADDPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vhaddpd Horizontal add packed double-precision floating-point values from ymm2 and ymm3/mem. + +F2 0F 7C /r HADDPS xmm1, xmm2/m128 RM RW, R V V PNI haddps Horizontal add packed single-precision floating-point values from xmm2/m128 to xmm1. +VEX.NDS.128.F2.0F.WIG 7C /r VHADDPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vhaddps Horizontal add packed single-precision floating-point values from xmm2 and xmm3/mem. +VEX.NDS.256.F2.0F.WIG 7C /r VHADDPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vhaddps Horizontal add packed single-precision floating-point values from ymm2 and ymm3/mem. + +F4 HLT NO YES V V Halt + +66 0F 7D /r HSUBPD xmm1, xmm2/m128 RM RW, R V V PNI hsubpd Horizontal subtract packed double-precision floating-point values from xmm2/m128 to xmm1. +VEX.NDS.128.66.0F.WIG 7D /r VHSUBPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vhsubpd Horizontal subtract packed double-precision floating-point values from xmm2 and xmm3/mem. +VEX.NDS.256.66.0F.WIG 7D /r VHSUBPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vhsubpd Horizontal subtract packed double-precision floating-point values from ymm2 and ymm3/mem. + +F2 0F 7D /r HSUBPS xmm1, xmm2/m128 RM RW, R V V PNI hsubps Horizontal subtract packed single-precision floating-point values from xmm2/m128 to xmm1. +VEX.NDS.128.F2.0F.WIG 7D /r VHSUBPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vhsubps Horizontal subtract packed single-precision floating-point values from xmm2 and xmm3/mem. +VEX.NDS.256.F2.0F.WIG 7D /r VHSUBPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vhsubps Horizontal subtract packed single-precision floating-point values from ymm2 and ymm3/mem. + +F6 /7 IDIV r/m8 M R AX AX E.CF E.OF E.SF E.ZF E.AF E.PF V V idivb Signed divide AX by r/m8, with result stored in: AL = Quotient, AH = Remainder. +REX+ F6 /7 IDIV r/m8 M R AX AX E.CF E.OF E.SF E.ZF E.AF E.PF V NE idivb Signed divide AX by r/m8, with result stored in AL = Quotient, AH = Remainder. +F7 /7 IDIV r/m16 M R AX DX AX DX E.CF E.OF E.SF E.ZF E.AF E.PF V V idivw Signed divide DX:AX by r/m16, with result stored in AX = Quotient, DX = Remainder. +F7 /7 IDIV r/m32 M R EAX EDX RAX RDX E.CF E.OF E.SF E.ZF E.AF E.PF V V idivl Signed divide EDX:EAX by r/m32, with result stored in EAX = Quotient, EDX = Remainder. +REX.W+ F7 /7 IDIV r/m64 M R RAX RDX RAX RDX E.CF E.OF E.SF E.ZF E.AF E.PF V NE idivq Signed divide RDX:RAX by r/m64, with result stored in RAX = Quotient, RDX = Remainder. + +F6 /5 IMUL r/m8 M R AL AX E.CF E.OF E.SF E.ZF E.AF E.PF V V imulb AX= AL * r/m byte. +REX+ F6 /5 IMUL r/m8 M R AL AX E.CF E.OF E.SF E.ZF E.AF E.PF V V imulb AX= AL * r/m byte. +F7 /5 IMUL r/m16 M R AX AX DX E.CF E.OF E.SF E.ZF E.AF E.PF V V imulw DX:AX = AX * r/m word. +F7 /5 IMUL r/m32 M R EAX RAX RDX E.CF E.OF E.SF E.ZF E.AF E.PF V V imull EDX:EAX = EAX * r/m32. +REX.W+ F7 /5 IMUL r/m64 M R RAX RAX RDX E.CF E.OF E.SF E.ZF E.AF E.PF V NE imulq RDX:RAX = RAX * r/m64. +0F AF /r IMUL r16, r/m16 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.PF V V imulw word register = word register * r/m16. +0F AF /r IMUL r32, r/m32 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.PF V V imull doubleword register = doubleword register * r/m32. +REX.W+ 0F AF /r IMUL r64, r/m64 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE imulq Quadword register = Quadword register * r/m64. +6B /r ib IMUL r16, r/m16, imm8 RMI W, R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V imulw word register = r/m16 * sign-extended immediate byte. +6B /r ib IMUL r32, r/m32, imm8 RMI W, R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V imull doubleword register = r/m32 * sign- extended immediate byte. +REX.W+ 6B /r ib IMUL r64, r/m64, imm8 RMI W, R, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE imulq Quadword register = r/m64 * sign-extended immediate byte. +69 /r iw IMUL r16, r/m16, imm16 RMI W, R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V imulw word register = r/m16 * immediate word. +69 /r id IMUL r32, r/m32, imm32 RMI W, R, R E.CF E.OF E.SF E.ZF E.AF E.PF V V imull doubleword register = r/m32 * immediate doubleword. +REX.W+ 69 /r id IMUL r64, r/m64, imm32 RMI W, R, R E.CF E.OF E.SF E.ZF E.AF E.PF V NE imulq Quadword register = r/m64 * immediate doubleword. + +E4 ib IN AL, imm8 I W, R E.IOPL E.VM V V inb Input byte from imm8 I/O port address into AL. +E5 ib IN AX, imm8 I W, R E.IOPL E.VM V V inw Input word from imm8 I/O port address into AX. +E5 ib IN EAX, imm8 I W, R E.IOPL E.VM V V inl Input dword from imm8 I/O port address into EAX. +EC IN AL,DX NP W, R E.IOPL E.VM V V inb Input byte from I/O port in DX into AL. +ED IN AX,DX NP W, R E.IOPL E.VM V V inw Input word from I/O port in DX into AX. +ED IN EAX,DX NP W, R E.IOPL E.VM V V inl Input doubleword from I/O port in DX into EAX. + +FE /0 INC r/m8 M RW E.OF E.SF E.ZF E.AF E.PF V V incb Increment r/m byte by 1. +REX+ FE /0 INC r/m8 M RW E.OF E.SF E.ZF E.AF E.PF V NE incb Increment r/m byte by 1. +FF /0 INC r/m16 M RW E.OF E.SF E.ZF E.AF E.PF V V incw Increment r/m word by 1. +FF /0 INC r/m32 M RW E.OF E.SF E.ZF E.AF E.PF V V incl Increment r/m doubleword by 1. +REX.W+ FF /0 INC r/m64 M RW E.OF E.SF E.ZF E.AF E.PF V NE incq Increment r/m quadword by 1. +40 +rw INC r16 NE V Increment word register by 1. +40 +rd INC r32 NE V Increment doubleword register by 1. + +6C INS m8, DX NP I, R E.IOPL E.VM E.DF RDI V V ins Input byte from I/O port specified in DX into memory location specified in ES:(E)DI or RDI. +6D INS m16, DX NP I, R E.IOPL E.VM E.DF RDI V V ins Input word from I/O port specified in DX into memory location specified in ES:(E)DI or RDI. +6D INS m32, DX NP I, R E.IOPL E.VM E.DF RDI V V ins Input doubleword from I/O port specified in DX into memory location specified in ES:(E)DI or RDI. +6C INSB NP E.IOPL E.VM E.DF DX RDI V V insb Input byte from I/O port specified in DX into memory location specified with ES:(E)DI or RDI. +PREF.66+ 6D INSW NP E.IOPL E.VM E.DF DX RDI V V insw Input word from I/O port specified in DX into memory location specified in ES:(E)DI or RDI. +6D INSD NP E.IOPL E.VM E.DF DX RDI V V insl Input doubleword from I/O port specified in DX into memory location specified in ES:(E)DI or RDI. + +66 0F 3A 21 /r ib INSERTPS xmm1, xmm2/m32, imm8 RMI RW, R, R V V SSE4_1 insertps Insert a single precision floating-point value selected by imm8 from xmm2/m32 into xmm1 at the specified destination element specified by imm8 and zero out destination elements in xmm1 as indicated in imm8. +VEX.NDS.128.66.0F3A.WIG 21 /r ib VINSERTPS xmm1, xmm2, xmm3/m32, imm8 RVMI RZ, RW, R, R V V AVX vinsertps Insert a single precision floating point value selected by imm8 from xmm3/m32 and merge into xmm2 at the specified destination element specified by imm8 and zero out destination elements in xmm1 as indicated in imm8. + +CC INT 3 NP R ??? ??? ??? V V int Interrupt 3-trap to debugger. +CD ib INT imm8 I R ??? ??? ??? V V int Interrupt vector number specified by immediate byte. +CE INTO I V Interrupt 4-if overflow flag is 1. + +0F 08 INVD NO YES V V Flush internal caches; initiate flushing of external caches. + +0F 01 /7 INVLPG m NO YES V V Invalidate TLB Entry for page that contains m. + +66 0F 38 82 /r INVPCID r32, m128 NE V INVPCID Invalidates entries in the TLBs and paging-structure caches based on invalidation type in r32 and descriptor in m128. +66 0F 38 82 /r INVPCID r64, m128 RM R, R V NE INVPCID invpcid Invalidates entries in the TLBs and paging-structure caches based on invalidation type in r64 and descriptor in m128. + +PREF.66+ CF IRET NP ??? ??? ??? V V iretw Interrupt return (16-bit operand size). +CF IRETD NP ??? ??? ??? V V iretl Interrupt return (32-bit operand size). +REX.W+ CF IRETQ NP ??? ??? ??? V NE iretq Interrupt return (64-bit operand size). + +77 cb JA rel8 D R E.CF E.ZF V V ja Jump short if above (CF=0 and ZF=0). +73 cb JAE rel8 D R E.CF V V jae Jump short if above or equal (CF=0). +72 cb JB rel8 D R E.CF V V jb Jump short if below (CF=1). +76 cb JBE rel8 D R E.CF E.ZF V V jbe Jump short if below or equal (CF=1 or ZF=1). +72 cb JC rel8 D R E.CF V V jc Jump short if carry (CF=1). +E3 cb JCXZ rel8 NE V Jump short if CX register is 0. +E3 cb JECXZ rel8 D R ECX V V jecxz Jump short if ECX register is 0. +E3 cb JRCXZ rel8 D R RCX V NE jrcxz Jump short if RCX register is 0. +74 cb JE rel8 D R E.ZF V V je Jump short if equal (ZF=1). +7F cb JG rel8 D R E.ZF E.SF E.OF V V jg Jump short if greater (ZF=0 and SF=OF). +7D cb JGE rel8 D R E.SF E.OF V V jge Jump short if greater or equal (SF=OF). +7C cb JL rel8 D R E.SF E.OF V V jl Jump short if less (SF!!= OF). +7E cb JLE rel8 D R E.ZF E.SF E.OF V V jle Jump short if less or equal (ZF=1 or SF!!= OF). +76 cb JNA rel8 D R E.CF E.ZF V V jna Jump short if not above (CF=1 or ZF=1). +72 cb JNAE rel8 D R E.CF V V jnae Jump short if not above or equal (CF=1). +73 cb JNB rel8 D R E.CF V V jnb Jump short if not below (CF=0). +77 cb JNBE rel8 D R E.CF E.ZF V V jnbe Jump short if not below or equal (CF=0 and ZF=0). +73 cb JNC rel8 D R E.CF V V jnc Jump short if not carry (CF=0). +75 cb JNE rel8 D R E.ZF V V jne Jump short if not equal (ZF=0). +7E cb JNG rel8 D R E.ZF E.SF E.OF V V jng Jump short if not greater (ZF=1 or SF!!= OF). +7C cb JNGE rel8 D R E.SF E.OF V V jnge Jump short if not greater or equal (SF!!= OF). +7D cb JNL rel8 D R E.SF E.OF V V jnl Jump short if not less (SF=OF). +7F cb JNLE rel8 D R E.ZF E.SF E.OF V V jnle Jump short if not less or equal (ZF=0 and SF=OF). +71 cb JNO rel8 D R E.OF V V jno Jump short if not overflow (OF=0). +7B cb JNP rel8 D R E.PF V V jnp Jump short if not parity (PF=0). +79 cb JNS rel8 D R E.SF V V jns Jump short if not sign (SF=0). +75 cb JNZ rel8 D R E.ZF V V jnz Jump short if not zero (ZF=0). +70 cb JO rel8 D R E.OF V V jo Jump short if overflow (OF=1). +7A cb JP rel8 D R E.PF V V jp Jump short if parity (PF=1). +7A cb JPE rel8 D R E.PF V V jpe Jump short if parity even (PF=1). +7B cb JPO rel8 D R E.PF V V jpo Jump short if parity odd (PF=0). +78 cb JS rel8 D R E.SF V V js Jump short if sign (SF=1). +74 cb JZ rel8 D R E.ZF V V jz Jump short if zero (ZF = 1). +0F 87 cw JA rel16 NS V Jump near if above (CF=0 and ZF=0). Not supported in 64-bit mode. +0F 87 cd JA rel32 D R E.CF E.ZF V V ja Jump near if above (CF=0 and ZF=0). +0F 83 cw JAE rel16 NS V Jump near if above or equal (CF=0). Not supported in 64-bit mode. +0F 83 cd JAE rel32 D R E.CF V V jae Jump near if above or equal (CF=0). +0F 82 cw JB rel16 NS V Jump near if below (CF=1). Not supported in 64-bit mode. +0F 82 cd JB rel32 D R E.CF V V jb Jump near if below (CF=1). +0F 86 cw JBE rel16 NS V Jump near if below or equal (CF=1 or ZF=1). Not supported in 64-bit mode. +0F 86 cd JBE rel32 D R E.CF E.ZF V V jbe Jump near if below or equal (CF=1 or ZF=1). +0F 82 cw JC rel16 NS V Jump near if carry (CF=1). Not supported in 64-bit mode. +0F 82 cd JC rel32 D R E.CF V V jc Jump near if carry (CF=1). +0F 84 cw JE rel16 NS V Jump near if equal (ZF=1). Not supported in 64-bit mode. +0F 84 cd JE rel32 D R E.ZF V V je Jump near if 0 (ZF=1). +0F 8F cw JG rel16 NS V Jump near if greater (ZF=0 and SF=OF). Not supported in 64-bit mode. +0F 8F cd JG rel32 D R E.ZF E.SF E.OF V V jg Jump near if greater (ZF=0 and SF=OF). +0F 8D cw JGE rel16 NS V Jump near if greater or equal (SF=OF). Not supported in 64-bit mode. +0F 8D cd JGE rel32 D R E.SF E.OF V V jge Jump near if greater or equal (SF=OF). +0F 8C cw JL rel16 NS V Jump near if less (SF!!= OF). Not supported in 64-bit mode. +0F 8C cd JL rel32 D R E.SF E.OF V V jl Jump near if less (SF!!= OF). +0F 8E cw JLE rel16 NS V Jump near if less or equal (ZF=1 or SF!!= OF). Not supported in 64-bit mode. +0F 8E cd JLE rel32 D R E.ZF E.SF E.OF V V jle Jump near if less or equal (ZF=1 or SF!!= OF). +0F 86 cw JNA rel16 NS V Jump near if not above (CF=1 or ZF=1). Not supported in 64-bit mode. +0F 86 cd JNA rel32 D R E.CF E.ZF V V jna Jump near if not above (CF=1 or ZF=1). +0F 82 cw JNAE rel16 NS V Jump near if not above or equal (CF=1). Not supported in 64-bit mode. +0F 82 cd JNAE rel32 D R E.CF V V jnae Jump near if not above or equal (CF=1). +0F 83 cw JNB rel16 NS V Jump near if not below (CF=0). Not supported in 64-bit mode. +0F 83 cd JNB rel32 D R E.CF V V jnb Jump near if not below (CF=0). +0F 87 cw JNBE rel16 NS V Jump near if not below or equal (CF=0 and ZF=0). Not supported in 64-bit mode. +0F 87 cd JNBE rel32 D R E.CF E.ZF V V jnbe Jump near if not below or equal (CF=0 and ZF=0). +0F 83 cw JNC rel16 NS V Jump near if not carry (CF=0). Not supported in 64-bit mode. +0F 83 cd JNC rel32 D R E.CF V V jnc Jump near if not carry (CF=0). +0F 85 cw JNE rel16 NS V Jump near if not equal (ZF=0). Not supported in 64-bit mode. +0F 85 cd JNE rel32 D R E.ZF V V jne Jump near if not equal (ZF=0). +0F 8E cw JNG rel16 NS V Jump near if not greater (ZF=1 or SF !!= OF). Not supported in 64-bit mode. +0F 8E cd JNG rel32 D R E.ZF E.SF E.OF V V jng Jump near if not greater (ZF=1 or SF !!= OF). +0F 8C cw JNGE rel16 NS V Jump near if not greater or equal (SF !!= OF). Not supported in 64-bit mode. +0F 8C cd JNGE rel32 D R E.SF E.OF V V jnge Jump near if not greater or equal (SF !!= OF). +0F 8D cw JNL rel16 NS V Jump near if not less (SF=OF). Not supported in 64-bit mode. +0F 8D cd JNL rel32 D R E.SF E.OF V V jnl Jump near if not less (SF=OF). +0F 8F cw JNLE rel16 NS V Jump near if not less or equal (ZF=0 and SF=OF). Not supported in 64-bit mode. +0F 8F cd JNLE rel32 D R E.ZF E.SF E.OF V V jnle Jump near if not less or equal (ZF=0 and SF=OF). +0F 81 cw JNO rel16 NS V Jump near if not overflow (OF=0). Not supported in 64-bit mode. +0F 81 cd JNO rel32 D R E.OF V V jno Jump near if not overflow (OF=0). +0F 8B cw JNP rel16 NS V Jump near if not parity (PF=0). Not supported in 64-bit mode. +0F 8B cd JNP rel32 D R E.PF V V jnp Jump near if not parity (PF=0). +0F 89 cw JNS rel16 NS V Jump near if not sign (SF=0). Not supported in 64-bit mode. +0F 89 cd JNS rel32 D R E.SF V V jns Jump near if not sign (SF=0). +0F 85 cw JNZ rel16 NS V Jump near if not zero (ZF=0). Not supported in 64-bit mode. +0F 85 cd JNZ rel32 D R E.ZF V V jnz Jump near if not zero (ZF=0). +0F 80 cw JO rel16 NS V Jump near if overflow (OF=1). Not supported in 64-bit mode. +0F 80 cd JO rel32 D R E.OF V V jo Jump near if overflow (OF=1). +0F 8A cw JP rel16 NS V Jump near if parity (PF=1). Not supported in 64-bit mode. +0F 8A cd JP rel32 D R E.PF V V jp Jump near if parity (PF=1). +0F 8A cw JPE rel16 NS V Jump near if parity even (PF=1). Not supported in 64-bit mode. +0F 8A cd JPE rel32 D R E.PF V V jpe Jump near if parity even (PF=1). +0F 8B cw JPO rel16 NS V Jump near if parity odd (PF=0). Not supported in 64-bit mode. +0F 8B cd JPO rel32 D R E.PF V V jpo Jump near if parity odd (PF=0). +0F 88 cw JS rel16 NS V Jump near if sign (SF=1). Not supported in 64-bit mode. +0F 88 cd JS rel32 D R E.SF V V js Jump near if sign (SF=1). +0F 84 cw JZ rel16 NS V Jump near if 0 (ZF=1). Not supported in 64-bit mode. +0F 84 cd JZ rel32 D R E.ZF V V jz Jump near if 0 (ZF=1). + +EB cb JMP rel8 D R RIP V V jmpq Jump short, RIP = RIP + 8-bit displacement sign extended to 64-bits +E9 cw JMP rel16 NS V Jump near, relative, displacement relative to next instruction. Not supported in 64-bit mode. +E9 cd JMP rel32 D R RIP V V jmpq Jump near, relative, RIP = RIP + 32-bit displacement sign extended to 64-bits +FF /4 JMP r/m16 NS V Jump near, absolute indirect, address = zero-extended r/m16. Not supported in 64-bit mode. +FF /4 JMP r/m32 NS V Jump near, absolute indirect, address given in r/m32. Not supported in 64-bit mode. +FF /4 JMP r/m64 M R RIP V NE jmpq Jump near, absolute indirect, RIP = 64-Bit offset from register or memory +EA cd JMP ptr16:16 I V Jump far, absolute, address given in operand +EA cp JMP ptr16:32 I V Jump far, absolute, address given in operand +FF /5 JMP m16:16 D R ??? ??? ??? V V jmpq Jump far, absolute indirect, address given in m16:16 +FF /5 JMP m16:32 D R ??? ??? ??? V V jmpq Jump far, absolute indirect, address given in m16:32. +REX.W+ FF /5 JMP m16:64 D R ??? ??? ??? V NE jmpq Jump far, absolute indirect, address given in m16:64. + +9F LAHF NP E.SF E.ZF E.PF E.AF E.CF AH V V LAHF_LM lahf Load: AH = EFLAGS(SF:ZF:0:AF:0:PF:1:CF). + +0F 02 /r LAR r16, r16/m16 RM W, R E.ZF YES NO V V larw r16 = access rights referenced by r16/m16 +0F 02 /r LAR r32, r32/m16 RM W, R E.ZF YES NO V V lar reg = access rights referenced by r32/m16 +REX.W+ 0F 02 /r LAR r64, r32/m16 RM W, R E.ZF YES NO V V lar reg = access rights referenced by r32/m16 + +F2 0F F0 /r LDDQU xmm1, m128 RM W, R V V PNI lddqu Load unaligned data from mem and return double quadword in xmm1. +VEX.128.F2.0F.WIG F0 /r VLDDQU xmm1, m128 RM Z, R V V AVX vlddqu Load unaligned packed integer values from mem to xmm1. +VEX.256.F2.0F.WIG F0 /r VLDDQU ymm1, m256 RM W, R V V AVX vlddqu Load unaligned packed integer values from mem to ymm1. + +0F AE /2 LDMXCSR m32 M R M.* V V SSE ldmxcsr Load MXCSR register from m32. +VEX.LZ.0F.WIG AE /2 VLDMXCSR m32 M R M.* V V AVX vldmxcsr Load MXCSR register from m32. + +C5 /r LDS r16, m16:16 I V Load DS:r16 with far pointer from memory. +C5 /r LDS r32, m16:32 I V Load DS:r32 with far pointer from memory. +0F B2 /r LSS r16, m16:16 RM W, R SS V V lssw Load SS:r16 with far pointer from memory. +0F B2 /r LSS r32, m16:32 RM W, R SS V V lssl Load SS:r32 with far pointer from memory. +REX.W+ 0F B2 /r LSS r64, m16:64 RM W, R SS V NE lss Load SS:r64 with far pointer from memory. +C4 /r LES r16, m16:16 I V Load ES:r16 with far pointer from memory. +C4 /r LES r32, m16:32 I V Load ES:r32 with far pointer from memory. +0F B4 /r LFS r16, m16:16 RM W, R FS V V lfsw Load FS:r16 with far pointer from memory. +0F B4 /r LFS r32, m16:32 RM W, R FS V V lfsl Load FS:r32 with far pointer from memory. +REX.W+ 0F B4 /r LFS r64, m16:64 RM W, R FS V NE lfs Load FS:r64 with far pointer from memory. +0F B5 /r LGS r16, m16:16 RM W, R GS V V lgsw Load GS:r16 with far pointer from memory. +0F B5 /r LGS r32, m16:32 RM W, R GS V V lgsl Load GS:r32 with far pointer from memory. +REX.W+ 0F B5 /r LGS r64, m16:64 RM W, R GS V NE lgs Load GS:r64 with far pointer from memory. + +8D /r LEA r16, m RM W, I V V leaw Store effective address for m in register r16. +8D /r LEA r32, m RM W, I V V leal Store effective address for m in register r32. +REX.W+ 8D /r LEA r64, m RM W, I V NE leaq Store effective address for m in register r64. + +PREF.66+ C9 LEAVE p66 NP I V V leavew Set SP to BP, then pop BP. +C9 LEAVE NE V Set ESP to EBP, then pop EBP. +C9 LEAVE NP V NE leaveq Set RSP to RBP, then pop RBP. + +0F AE E8 LFENCE NP V V lfence Serializes load operations. + +0F 01 /2 LGDT m16&32 NO YES NE V Load m into GDTR. +0F 01 /3 LIDT m16&32 NO YES NE V Load m into IDTR. +0F 01 /2 LGDT m16&64 NO YES V NE Load m into GDTR. +0F 01 /3 LIDT m16&64 NO YES V NE Load m into IDTR. + +0F 00 /2 LLDT r/m16 NO YES V V Load segment selector r/m16 into LDTR. + +0F 01 /6 LMSW r/m16 NO YES V V Loads r/m16 in machine status word of CR0. + +F0 LOCK NP YES NO V V lock Asserts LOCK# signal for duration of the accompanying instruction. + +AC LODS m8 NP I E.DF SI rsi AL V V lods For legacy mode, Load byte at address DS:(E)SI into AL. For 64-bit mode load byte at address (R)SI into AL. +AD LODS m16 NP I E.DF SI rsi AX V V lods For legacy mode, Load word at address DS:(E)SI into AX. For 64-bit mode load word at address (R)SI into AX. +AD LODS m32 NP I E.DF SI rsi EAX V V lods For legacy mode, Load dword at address DS:(E)SI into EAX. For 64-bit mode load dword at address (R)SI into EAX. +REX.W+ AD LODS m64 NP I E.DF SI rsi RAX V NE lods Load qword at address (R)SI into RAX. +AC LODSB NP E.DF SI rsi AL V V lodsb For legacy mode, Load byte at address DS:(E)SI into AL. For 64-bit mode load byte at address (R)SI into AL. +PREF.66+ AD LODSW NP E.DF SI rsi AX V V lodsw For legacy mode, Load word at address DS:(E)SI into AX. For 64-bit mode load word at address (R)SI into AX. +AD LODSD NP E.DF SI rsi EAX V V lodsl For legacy mode, Load dword at address DS:(E)SI into EAX. For 64-bit mode load dword at address (R)SI into EAX. +REX.W+ AD LODSQ NP E.DF SI rsi RAX V NE lodsq Load qword at address (R)SI into RAX. + +E2 cb LOOP rel8 D R RCX E.ZF V V loop Decrement count; jump short if count !!= 0. +E0 cb LOOPE rel8 D R RCX E.ZF V V loope Decrement count; jump short if count !!= 0 and ZF = 1. +E0 cb LOOPNE rel8 D R RCX E.ZF V V loopne Decrement count; jump short if count !!= 0 and ZF = 0. + +0F 03 /r LSL r16, r16/m16 RM W, R E.ZF YES NO V V lslw Load: r16 = segment limit, selector r16/m16. +0F 03 /r LSL r32, r32/m16 RM W, R E.ZF YES NO V V lsl Load: r32 = segment limit, selector r32/m16. +REX.W+ 0F 03 /r LSL r64, r32/m16 RM W, R E.ZF YES NO V V lsl Load: r64 = segment limit, selector r32/m16 + +0F 00 /3 LTR r/m16 NO YES V V Load r/m16 into task register. + +F3 0F BD /r LZCNT r16, r/m16 RM W, R E.ZF E.CF E.AF E.PF E.SF E.OF V V BMI1 lzcntw Count the number of leading zero bits in r/m16, return result in r16 +F3 0F BD /r LZCNT r32, r/m32 RM W, R E.ZF E.CF E.AF E.PF E.SF E.OF V V BMI1 lzcntl Count the number of leading zero bits in r/m32, return result in r32 +REX.W+ F3 0F BD /r LZCNT r64, r/m64 RM W, R E.ZF E.CF E.AF E.PF E.SF E.OF V NE BMI1 lzcntq Count the number of leading zero bits in r/m64, return result in r64 + +66 0F F7 /r MASKMOVDQU xmm1, xmm2 RM R, R V V SSE2 maskmovdqu Selectively write bytes from xmm1 to memory location using the byte mask in xmm2. The default memory location is specified by DS:DI/EDI/RDI. +VEX.128.66.0F.WIG F7 /r VMASKMOVDQU xmm1, xmm2 RM R, R V V AVX vmaskmovdqu Selectively write bytes from xmm1 to memory location using the byte mask in xmm2. The default memory location is specified by DS:DI/EDI/RDI. + +0F F7 /r MASKMOVQ mm1, mm2 RM R, R V V maskmovq Selectively write bytes from mm1 to memory location using the byte mask in mm2. The default memory location is specified by DS:DI/EDI/RDI. + +66 0F 5F /r MAXPD xmm1, xmm2/m128 RM RW, R V V SSE2 maxpd Return the maximum double-precision floating-point values between xmm2/m128 and xmm1. +VEX.NDS.128.66.0F.WIG 5F /r VMAXPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vmaxpd Return the maximum double-precision floating-point values between xmm2 and xmm3/mem. +VEX.NDS.256.66.0F.WIG 5F /r VMAXPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vmaxpd Return the maximum packed double-precision floating-point values between ymm2 and ymm3/mem. + +0F 5F /r MAXPS xmm1, xmm2/m128 RM RW, R V V SSE maxps Return the maximum single-precision floating-point values between xmm2/m128 and xmm1. +VEX.NDS.128.0F.WIG 5F /r VMAXPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vmaxps Return the maximum single-precision floating-point values between xmm2 and xmm3/mem. +VEX.NDS.256.0F.WIG 5F /r VMAXPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vmaxps Return the maximum single double-precision floating-point values between ymm2 and ymm3/mem. + +F2 0F 5F /r MAXSD xmm1, xmm2/m64 RM RW, R V V SSE2 maxsd Return the maximum scalar double-precision floating-point value between xmm2/mem64 and xmm1. +VEX.NDS.LIG.F2.0F.WIG 5F /r VMAXSD xmm1, xmm2, xmm3/m64 RVM Z, R, R V V AVX vmaxsd Return the maximum scalar double-precision floating-point value between xmm3/mem64 and xmm2. + +F3 0F 5F /r MAXSS xmm1, xmm2/m32 RM RW, R V V SSE maxss Return the maximum scalar single-precision floating-point value between xmm2/mem32 and xmm1. +VEX.NDS.LIG.F3.0F.WIG 5F /r VMAXSS xmm1, xmm2, xmm3/m32 RVM Z, R, R V V AVX vmaxss Return the maximum scalar single-precision floating-point value between xmm3/mem32 and xmm2. + +0F AE F0 MFENCE NP V V mfence Serializes load and store operations. + +66 0F 5D /r MINPD xmm1, xmm2/m128 RM RW, R V V SSE2 minpd Return the minimum double-precision floating-point values between xmm2/m128 and xmm1. +VEX.NDS.128.66.0F.WIG 5D /r VMINPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vminpd Return the minimum double-precision floating-point values between xmm2 and xmm3/mem. +VEX.NDS.256.66.0F.WIG 5D /r VMINPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vminpd Return the minimum packed double-precision floating-point values between ymm2 and ymm3/mem. + +0F 5D /r MINPS xmm1, xmm2/m128 RM RW, R V V SSE minps Return the minimum single-precision floating-point values between xmm2/m128 and xmm1. +VEX.NDS.128.0F.WIG 5D /r VMINPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vminps Return the minimum single-precision floating-point values between xmm2 and xmm3/mem. +VEX.NDS.256.0F.WIG 5D /r VMINPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vminps Return the minimum single double-precision floating-point values between ymm2 and ymm3/mem. + +F2 0F 5D /r MINSD xmm1, xmm2/m64 RM RW, R V V SSE2 minsd Return the minimum scalar double-precision floating-point value between xmm2/mem64 and xmm1. +VEX.NDS.LIG.F2.0F.WIG 5D /r VMINSD xmm1, xmm2, xmm3/m64 RVM Z, R, R V V AVX vminsd Return the minimum scalar double precision floating-point value between xmm3/mem64 and xmm2. + +F3 0F 5D /r MINSS xmm1, xmm2/m32 RM RW, R V V SSE minss Return the minimum scalar single-precision floating-point value between xmm2/mem32 and xmm1. +VEX.NDS.LIG.F3.0F.WIG 5D /r VMINSS xmm1,xmm2, xmm3/m32 RVM Z, R, R V V AVX vminss Return the minimum scalar single precision floating-point value between xmm3/mem32 and xmm2. + +0F 01 C8 MONITOR NP V V MONITOR monitor Sets up a linear address range to be monitored by hardware and activates the monitor. The address range should be a write-back memory caching type. The address is DS:EAX (DS:RAX in 64-bit mode). + +88 /r MOV r/m8, r8 MR W, R V V movb YES Move r8 to r/m8. +REX+ 88 /r MOV r/m8, r8 MR W, R V NE movb YES Move r8 to r/m8. +89 /r MOV r/m16, r16 MR W, R V V movw YES Move r16 to r/m16. +89 /r MOV r/m32, r32 MR W, R V V movl YES Move r32 to r/m32. +REX.W+ 89 /r MOV r/m64, r64 MR W, R V NE movq YES Move r64 to r/m64. +8A /r MOV r8, r/m8 RM W, R V V movb Move r/m8 to r8. +REX+ 8A /r MOV r8, r/m8 RM W, R V NE movb Move r/m8 to r8. +8B /r MOV r16, r/m16 RM W, R V V movw Move r/m16 to r16. +8B /r MOV r32, r/m32 RM W, R V V movl Move r/m32 to r32. +REX.W+ 8B /r MOV r64, r/m64 RM W, R V NE movq Move r/m64 to r64. +8C /r MOV r/m16, Sreg MR W, R V V movw Move segment register to r/m16. +REX.W+ 8C /r MOV r/m64, Sreg MR W, R V V movq Move zero extended 16-bit segment register to r/m64. +8E /r MOV Sreg, r/m16 RM W, R V V mov Move r/m16 to segment register. +REX.W+ 8E /r MOV Sreg, r/m64 RM W, R V V mov Move lower 16 bits of r/m64 to segment register. +A0 MOV AL, moffs8 FD W, R V V movabsb Move byte at (seg:offset) to AL. +REX.W+ A0 MOV AL, moffs8, pw FD W, R, I V NE movabsb Move byte at (offset) to AL. +A1 MOV AX, moffs16 FD W, R V V movabsw Move word at (seg:offset) to AX. +A1 MOV EAX, moffs32 FD W, R V V movabsl Move doubleword at (seg:offset) to EAX. +REX.W+ A1 MOV RAX, moffs64 FD W, R V NE movabsq Move quadword at (offset) to RAX. +A2 MOV moffs8, AL TD W, R V V movabsb Move AL to (seg:offset). +REX.W+ A2 MOV moffs8, AL, pw TD W, R, I V NE movabsb Move AL to (offset). +A3 MOV moffs16, AX TD W, R V V movabsw Move AX to (seg:offset). +A3 MOV moffs32, EAX TD W, R V V movabsl Move EAX to (seg:offset). +REX.W+ A3 MOV moffs64, RAX TD W, R V NE movabsq Move RAX to (offset). +B0 +rb MOV r8, imm8 OI W, R V V movb YES Move imm8 to r8. +REX+ B0 +rb MOV r8, imm8 OI W, R V NE movb YES Move imm8 to r8. +B8 +rw MOV r16, imm16 OI W, R V V movw YES Move imm16 to r16. +B8 +rd MOV r32, imm32 OI W, R V V movl YES Move imm32 to r32. +REX.W+ B8 +rd MOV r64, imm64 OI W, R V NE movq Move imm64 to r64. +C6 /0 MOV r/m8, imm8 MI W, R V V movb Move imm8 to r/m8. +REX+ C6 /0 MOV r/m8, imm8 MI W, R V NE movb Move imm8 to r/m8. +C7 /0 MOV r/m16, imm16 MI W, R V V movw Move imm16 to r/m16. +C7 /0 MOV r/m32, imm32 MI W, R V V movl Move imm32 to r/m32. +REX.W+ C7 /0 MOV r/m64, imm32 MI W, R V NE movq YES Move imm32 sign extended to 64-bits to r/m64. + +0F 20 /r MOV r32, CR0-CR7 NO YES NE V Move control register to r32. +0F 20 /r MOV r64, CR0-CR7 NO YES V NE Move extended control register to r64. +REX.R+ 0F 20 MOV r64, CR8 NO YES V NE Move extended CR8 to r64.1 +0F 22 /r MOV CR0-CR7, r32 NO YES NE V Move r32 to control register. +0F 22 /r MOV CR0-CR7, r64 NO YES V NE Move r64 to extended control register. +REX.R+ 0F 22 MOV CR8, r64 NO YES V NE Move r64 to extended CR8.1 + +0F 21 /r MOV r32, DR0-DR7 NO YES NE V Move debug register to r32. +0F 21 /r MOV r64, DR0-DR7 NO YES V NE Move extended debug register to r64. +0F 23 /r MOV DR0-DR7, r32 NO YES NE V Move r32 to debug register. +0F 23 /r MOV DR0-DR7, r64 NO YES V NE Move r64 to extended debug register. + +66 0F 28 /r MOVAPD xmm1, xmm2/m128 RM W, R V V SSE2 movapd Move packed double-precision floating-point values from xmm2/m128 to xmm1. +66 0F 29 /r MOVAPD xmm2/m128, xmm1 MR W, R V V SSE2 movapd YES Move packed double-precision floating-point values from xmm1 to xmm2/m128. +VEX.128.66.0F.WIG 28 /r VMOVAPD xmm1, xmm2/m128 RM Z, R V V AVX vmovapd YES Move aligned packed double-precision floating-point values from xmm2/mem to xmm1. +VEX.128.66.0F.WIG 29 /r VMOVAPD xmm2/m128, xmm1 MR Z, R V V AVX vmovapd Move aligned packed double-precision floating-point values from xmm1 to xmm2/mem. +VEX.256.66.0F.WIG 28 /r VMOVAPD ymm1, ymm2/m256 RM W, R V V AVX vmovapd YES Move aligned packed double-precision floating-point values from ymm2/mem to ymm1. +VEX.256.66.0F.WIG 29 /r VMOVAPD ymm2/m256, ymm1 MR W, R V V AVX vmovapd Move aligned packed double-precision floating-point values from ymm1 to ymm2/mem. + +0F 28 /r MOVAPS xmm1, xmm2/m128 RM W, R V V SSE movaps Move packed single-precision floating-point values from xmm2/m128 to xmm1. +0F 29 /r MOVAPS xmm2/m128, xmm1 MR W, R V V SSE movaps YES Move packed single-precision floating-point values from xmm1 to xmm2/m128. +VEX.128.0F.WIG 28 /r VMOVAPS xmm1, xmm2/m128 RM Z, R V V AVX vmovaps YES Move aligned packed single-precision floating-point values from xmm2/mem to xmm1. +VEX.128.0F.WIG 29 /r VMOVAPS xmm2/m128, xmm1 MR Z, R V V AVX vmovaps Move aligned packed single-precision floating-point values from xmm1 to xmm2/mem. +VEX.256.0F.WIG 28 /r VMOVAPS ymm1, ymm2/m256 RM W, R V V AVX vmovaps YES Move aligned packed single-precision floating-point values from ymm2/mem to ymm1. +VEX.256.0F.WIG 29 /r VMOVAPS ymm2/m256, ymm1 MR W, R V V AVX vmovaps Move aligned packed single-precision floating-point values from ymm1 to ymm2/mem. + +0F 38 F0 /r MOVBE r16, m16 RM W, R V V MOVBE movbew Reverse byte order in m16 and move to r16 +0F 38 F0 /r MOVBE r32, m32 RM W, R V V MOVBE movbel Reverse byte order in m32 and move to r32 +REX.W+ 0F 38 F0 /r MOVBE r64, m64 RM W, R V NE MOVBE movbeq Reverse byte order in m64 and move to r64. +0F 38 F1 /r MOVBE m16, r16 MR W, R V V MOVBE movbew Reverse byte order in r16 and move to m16 +0F 38 F1 /r MOVBE m32, r32 MR W, R V V MOVBE movbel Reverse byte order in r32 and move to m32 +REX.W+ 0F 38 F1 /r MOVBE m64, r64 MR W, R V NE MOVBE movbeq Reverse byte order in r64 and move to m64. + +0F 6E /r MOVD mm, r/m32 RM W, R V V MMX movd Move doubleword from r/m32 to mm. +REX.W+ 0F 6E /r MOVQ mm, r/m64 RM W, R V NE MMX movq YES Move quadword from r/m64 to mm. +0F 7E /r MOVD r/m32, mm MR W, R V V MMX movd Move doubleword from mm to r/m32. +REX.W+ 0F 7E /r MOVQ r/m64, mm MR W, R V NE MMX movq YES Move quadword from mm to r/m64. +VEX.128.66.0F.W0 6E /r VMOVD xmm1, r32/m32 RM Z, R V V AVX vmovd Move doubleword from r/m32 to xmm1. +VEX.128.66.0F.W1 6E /r VMOVQ xmm1, r64/m64 RM Z, R V NE AVX vmovq YES Move quadword from r/m64 to xmm1. +66 0F 6E /r MOVD xmm, r/m32 RM W, R V V SSE2 movd Move doubleword from r/m32 to xmm. +66 REX.W+ 0F 6E /r MOVQ xmm, r/m64 RM W, R V NE SSE2 movq YES Move quadword from r/m64 to xmm. +66 0F 7E /r MOVD r/m32, xmm MR W, R V V SSE2 movd Move doubleword from xmm register to r/m32. +66 REX.W+ 0F 7E /r MOVQ r/m64, xmm MR W, R V NE SSE2 movq YES Move quadword from xmm register to r/m64. +VEX.128.66.0F.W0 7E /r VMOVD r32/m32, xmm1 MR W, R V V AVX vmovd Move doubleword from xmm1 register to r/m32. +VEX.128.66.0F.W1 7E /r VMOVQ r64/m64, xmm1 MR W, R V NE AVX vmovq YES Move quadword from xmm1 register to r/m64. + +F2 0F 12 /r MOVDDUP xmm1, xmm2/m64 RM W, R V V PNI movddup Move one double-precision floating-point value from the lower 64-bit operand in xmm2/m64 to xmm1 and duplicate. +VEX.128.F2.0F.WIG 12 /r VMOVDDUP xmm1, xmm2/m64 RM Z, R V V AVX vmovddup Move double-precision floating-point values from xmm2/mem and duplicate into xmm1. +VEX.256.F2.0F.WIG 12 /r VMOVDDUP ymm1, ymm2/m256 RM W, R V V AVX vmovddup Move even index double-precision floating-point values from ymm2/mem and duplicate each element into ymm1. + +66 0F 6F /r MOVDQA xmm1, xmm2/m128 RM W, R V V SSE2 movdqa YES Move aligned double quadword from xmm2/m128 to xmm1. +66 0F 7F /r MOVDQA xmm2/m128, xmm1 MR W, R V V SSE2 movdqa Move aligned double quadword from xmm1 to xmm2/m128. +VEX.128.66.0F.WIG 6F /r VMOVDQA xmm1, xmm2/m128 RM Z, R V V AVX vmovdqa YES Move aligned packed integer values from xmm2/mem to xmm1. +VEX.128.66.0F.WIG 7F /r VMOVDQA xmm2/m128, xmm1 MR Z, R V V AVX vmovdqa Move aligned packed integer values from xmm1 to xmm2/mem. +VEX.256.66.0F.WIG 6F /r VMOVDQA ymm1, ymm2/m256 RM W, R V V AVX vmovdqa YES Move aligned packed integer values from ymm2/mem to ymm1. +VEX.256.66.0F.WIG 7F /r VMOVDQA ymm2/m256, ymm1 MR W, R V V AVX vmovdqa Move aligned packed integer values from ymm1 to ymm2/mem. + +F3 0F 6F /r MOVDQU xmm1, xmm2/m128 RM W, R V V SSE2 movdqu YES Move unaligned double quadword from xmm2/m128 to xmm1. +F3 0F 7F /r MOVDQU xmm2/m128, xmm1 MR W, R V V SSE2 movdqu Move unaligned double quadword from xmm1 to xmm2/m128. +VEX.128.F3.0F.WIG 6F /r VMOVDQU xmm1, xmm2/m128 RM Z, R V V AVX vmovdqu YES Move unaligned packed integer values from xmm2/mem to xmm1. +VEX.128.F3.0F.WIG 7F /r VMOVDQU xmm2/m128, xmm1 MR Z, R V V AVX vmovdqu Move unaligned packed integer values from xmm1 to xmm2/mem. +VEX.256.F3.0F.WIG 6F /r VMOVDQU ymm1, ymm2/m256 RM W, R V V AVX vmovdqu YES Move unaligned packed integer values from ymm2/mem to ymm1. +VEX.256.F3.0F.WIG 7F /r VMOVDQU ymm2/m256, ymm1 MR W, R V V AVX vmovdqu Move unaligned packed integer values from ymm1 to ymm2/mem. + +F2 0F D6 MOVDQ2Q mm, xmm RM W, R V V MMX movdq2q Move low quadword from xmm to mmx register. + +0F 12 /r MOVHLPS xmm1, xmm2 RM RW, R V V SSE movhlps Move two packed single-precision floating-point values from high quadword of xmm2 to low quadword of xmm1. +VEX.NDS.128.0F.WIG 12 /r VMOVHLPS xmm1, xmm2, xmm3 RVM Z, R, R V V AVX vmovhlps Merge two packed single-precision floating-point values from high quadword of xmm3 and low quadword of xmm2. + +66 0F 16 /r MOVHPD xmm, m64 RM RW, R V V SSE2 movhpd Move double-precision floating-point value from m64 to high quadword of xmm. +66 0F 17 /r MOVHPD m64, xmm MR W, R V V SSE2 movhpd Move double-precision floating-point value from high quadword of xmm to m64. +VEX.NDS.128.66.0F.WIG 16 /r VMOVHPD xmm2, xmm1, m64 RVM Z, R, R V V AVX vmovhpd Merge double-precision floating-point value from m64 and the low quadword of xmm1. +VEX128.66.0F.WIG 17 /r VMOVHPD m64, xmm1 MR W, R V V AVX vmovhpd Move double-precision floating-point values from high quadword of xmm1 to m64. + +0F 16 /r MOVHPS xmm, m64 RM RW, R V V SSE movhps Move two packed single-precision floating-point values from m64 to high quadword of xmm. +0F 17 /r MOVHPS m64, xmm MR W, R V V SSE movhps Move two packed single-precision floating-point values from high quadword of xmm to m64. +VEX.NDS.128.0F.WIG 16 /r VMOVHPS xmm2, xmm1, m64 RVM Z, R, R V V AVX vmovhps Merge two packed single-precision floating-point values from m64 and the low quadword of xmm1. +VEX.128.0F.WIG 17 /r VMOVHPS m64, xmm1 MR W, R V V AVX vmovhps Move two packed single-precision floating-point values from high quadword of xmm1to m64. + +0F 16 /r MOVLHPS xmm1, xmm2 RM RW, R V V SSE movlhps Move two packed single-precision floating-point values from low quadword of xmm2 to high quadword of xmm1. +VEX.NDS.128.0F.WIG 16 /r VMOVLHPS xmm1, xmm2, xmm3 RVM Z, R, R V V AVX vmovlhps Merge two packed single-precision floating-point values from low quadword of xmm3 and low quadword of xmm2. + +66 0F 12 /r MOVLPD xmm, m64 RM RW, R V V SSE2 movlpd Move double-precision floating-point value from m64 to low quadword of xmm register. +66 0F 13 /r MOVLPD m64, xmm MR W, R V V SSE2 movlpd Move double-precision floating-point nvalue from low quadword of xmm register to m64. +VEX.NDS.128.66.0F.WIG 12 /r VMOVLPD xmm2, xmm1, m64 RVM Z, R, R V V AVX vmovlpd Merge double-precision floating-point value from m64 and the high quadword of xmm1. +VEX.128.66.0F.WIG 13 /r VMOVLPD m64, xmm1 MR W, R V V AVX vmovlpd Move double-precision floating-point values from low quadword of xmm1 to m64. + +0F 12 /r MOVLPS xmm, m64 RM RW, R V V SSE movlps Move two packed single-precision floating-point values from m64 to low quadword of xmm. +0F 13 /r MOVLPS m64, xmm MR W, R V V SSE movlps Move two packed single-precision floating-point values from low quadword of xmm to m64. +VEX.NDS.128.0F.WIG 12 /r VMOVLPS xmm2, xmm1, m64 RVM Z, R, R V V AVX vmovlps Merge two packed single-precision floating-point values from m64 and the high quadword of xmm1. +VEX.128.0F.WIG 13 /r VMOVLPS m64, xmm1 MR W, R V V AVX vmovlps Move two packed single-precision floating-point values from low quadword of xmm1 to m64. + +66 0F 50 /r MOVMSKPD reg, xmm RM W, R V V SSE2 movmskpd Extract 2-bit sign mask from xmm and store in reg. The upper bits of r32 or r64 are filled with zeros. +VEX.128.66.0F.WIG 50 /r VMOVMSKPD reg, xmm2 RM W, R V V AVX vmovmskpd Extract 2-bit sign mask from xmm2 and store in reg. The upper bits of r32 or r64 are zeroed. +VEX.256.66.0F.WIG 50 /r VMOVMSKPD reg, ymm2 RM W, R V V AVX vmovmskpd Extract 4-bit sign mask from ymm2 and store in reg. The upper bits of r32 or r64 are zeroed. + +0F 50 /r MOVMSKPS reg, xmm RM W, R V V SSE movmskps Extract 4-bit sign mask from xmm and store in reg. The upper bits of r32 or r64 are filled with zeros. +VEX.128.0F.WIG 50 /r VMOVMSKPS reg, xmm2 RM W, R V V AVX vmovmskps Extract 4-bit sign mask from xmm2 and store in reg. The upper bits of r32 or r64 are zeroed. +VEX.256.0F.WIG 50 /r VMOVMSKPS reg, ymm2 RM W, R V V AVX vmovmskps Extract 8-bit sign mask from ymm2 and store in reg. The upper bits of r32 or r64 are zeroed. + +66 0F 38 2A /r MOVNTDQA xmm1, m128 RM W, R V V SSE4_1 movntdqa Move double quadword from m128 to xmm using non-temporal hint if WC memory type. +VEX.128.66.0F38.WIG 2A /r VMOVNTDQA xmm1, m128 RM Z, R V V AVX vmovntdqa Move double quadword from m128 to xmm using non-temporal hint if WC memory type. +VEX.256.66.0F38.WIG 2A /r VMOVNTDQA ymm1, m256 RM W, R V V AVX2 vmovntdqa Move 256-bit data from m256 to ymm using non-temporal hint if WC memory type. + +66 0F E7 /r MOVNTDQ m128, xmm MR W, R V V SSE2 movntdq Move double quadword from xmm to m128 using non-temporal hint. +VEX.128.66.0F.WIG E7 /r VMOVNTDQ m128, xmm1 MR W, R V V AVX vmovntdq Move packed integer values in xmm1 to m128 using non-temporal hint. +VEX.256.66.0F.WIG E7 /r VMOVNTDQ m256, ymm1 MR W, R V V AVX vmovntdq Move packed integer values in ymm1 to m256 using non-temporal hint. + +0F C3 /r MOVNTI m32, r32 MR W, R V V movnti Move doubleword from r32 to m32 using non-temporal hint. +REX.W+ 0F C3 /r MOVNTI m64, r64 MR W, R V NE movnti Move quadword from r64 to m64 using non-temporal hint. + +66 0F 2B /r MOVNTPD m128, xmm MR W, R V V SSE2 movntpd Move packed double-precision floating-point values from xmm to m128 using non-temporal hint. +VEX.128.66.0F.WIG 2B /r VMOVNTPD m128, xmm1 MR W, R V V AVX vmovntpd Move packed double-precision values in xmm1 to m128 using non-temporal hint. +VEX.256.66.0F.WIG 2B /r VMOVNTPD m256, ymm1 MR W, R V V AVX vmovntpd Move packed double-precision values in ymm1 to m256 using non-temporal hint. + +0F 2B /r MOVNTPS m128, xmm MR W, R V V SSE movntps Move packed single-precision floating-point values from xmm to m128 using non-temporal hint. +VEX.128.0F.WIG 2B /r VMOVNTPS m128, xmm1 MR W, R V V AVX vmovntps Move packed single-precision values xmm1 to mem using non-temporal hint. +VEX.256.0F.WIG 2B /r VMOVNTPS m256, ymm1 MR W, R V V AVX vmovntps Move packed single-precision values ymm1 to mem using non-temporal hint. + +0F E7 /r MOVNTQ m64, mm MR W, R V V movntq Move quadword from mm to m64 using non-temporal hint. + +0F 6F /r MOVQ mm, mm/m64 RM W, R V V MMX movq YES Move quadword from mm/m64 to mm. +0F 7F /r MOVQ mm/m64, mm MR W, R V V MMX movq Move quadword from mm to mm/m64. +F3 0F 7E MOVQ xmm1, xmm2/m64 RM W, R V V SSE2 movq YES Move quadword from xmm2/mem64 to xmm1. +VEX.128.F3.0F.WIG 7E /r VMOVQ xmm1, xmm2 RM Z, R V V AVX vmovq Move quadword from xmm2 to xmm1. +VEX.128.F3.0F.WIG 7E /r VMOVQ xmm1, m64 RM Z, R V V AVX vmovq Load quadword from m64 to xmm1. +66 0F D6 MOVQ xmm2/m64, xmm1 MR W, R V V SSE2 movq Move quadword from xmm1 to xmm2/mem64. +VEX.128.66.0F.WIG D6 /r VMOVQ xmm1/m64, xmm2 MR Z, R V V AVX vmovq YES Move quadword from xmm2 register to xmm1/m64. + +F3 0F D6 MOVQ2DQ xmm, mm RM W, R V V MMX movq2dq Move quadword from mmx to low quadword of xmm. + +A4 MOVS m8, m8 NP I, I E.DF ESI rsi EDI rdi V V movs For legacy mode, Move byte from address DS:(E)SI to ES:(E)DI. For 64-bit mode move byte from address (R|E)SI to (R|E)DI. +A5 MOVS m16, m16 NP I, I E.DF ESI rsi EDI rdi V V movs For legacy mode, move word from address DS:(E)SI to ES:(E)DI. For 64-bit mode move word at address (R|E)SI to (R|E)DI. +A5 MOVS m32, m32 NP I, I E.DF ESI rsi EDI rdi V V movs For legacy mode, move dword from address DS:(E)SI to ES:(E)DI. For 64-bit mode move dword from address (R|E)SI to (R|E)DI. +REX.W+ A5 MOVS m64, m64 NP I, I E.DF ESI rsi EDI rdi V NE movs Move qword from address (R|E)SI to (R|E)DI. +A4 MOVSB NP E.DF ESI rsi EDI rdi V V movsb For legacy mode, Move byte from address DS:(E)SI to ES:(E)DI. For 64-bit mode move byte from address (R|E)SI to (R|E)DI. +PREF.66+ A5 MOVSW NP E.DF ESI rsi EDI rdi V V movsw For legacy mode, move word from address DS:(E)SI to ES:(E)DI. For 64-bit mode move word at address (R|E)SI to (R|E)DI. +A5 MOVSD NP E.DF ESI rsi EDI rdi V V movsl For legacy mode, move dword from address DS:(E)SI to ES:(E)DI. For 64-bit mode move dword from address (R|E)SI to (R|E)DI. +REX.W+ A5 MOVSQ NP E.DF ESI rsi EDI rdi V NE movsq Move qword from address (R|E)SI to (R|E)DI. + +F2 0F 10 /r MOVSD xmm1, xmm2/m64 RM RW, R V V SSE2 movsd YES Move scalar double-precision floating-point value from xmm2/m64 to xmm1 register. +VEX.NDS.LIG.F2.0F.WIG 10 /r VMOVSD xmm1, xmm2, xmm3 RVM Z, R, R V V AVX vmovsd Merge scalar double-precision floating-point value from xmm2 and xmm3 to xmm1 register. +VEX.LIG.F2.0F.WIG 10 /r VMOVSD xmm1, m64 XM Z, R V V AVX vmovsd Load scalar double-precision floating-point value from m64 to xmm1 register. +F2 0F 11 /r MOVSD xmm2/m64, xmm1 MR QW, R V V SSE2 movsd Move scalar double-precision floating-point value from xmm1 register to xmm2/m64. +VEX.NDS.LIG.F2.0F.WIG 11 /r VMOVSD xmm1, xmm2, xmm3 MVR Z, R, R V V AVX vmovsd YES Merge scalar double-precision floating-point value from xmm2 and xmm3 registers to xmm1. +VEX.LIG.F2.0F.WIG 11 /r VMOVSD m64, xmm1 MR W, R V V AVX vmovsd Move scalar double-precision floating-point value from xmm1 register to m64. + +F3 0F 16 /r MOVSHDUP xmm1, xmm2/m128 RM W, R V V PNI movshdup Move two single-precision floating-point values from the higher 32-bit operand of each qword in xmm2/m128 to xmm1 and duplicate each 32-bit operand to the lower 32-bits of each qword. +VEX.128.F3.0F.WIG 16 /r VMOVSHDUP xmm1, xmm2/m128 RM Z, R V V AVX vmovshdup Move odd index single-precision floating-point values from xmm2/mem and duplicate each element into xmm1. +VEX.256.F3.0F.WIG 16 /r VMOVSHDUP ymm1, ymm2/m256 RM W, R V V AVX vmovshdup Move odd index single-precision floating-point values from ymm2/mem and duplicate each element into ymm1. + +F3 0F 12 /r MOVSLDUP xmm1, xmm2/m128 RM W, R V V PNI movsldup Move two single-precision floating-point values from the lower 32-bit operand of each qword in xmm2/m128 to xmm1 and duplicate each 32-bit operand to the higher 32-bits of each qword. +VEX.128.F3.0F.WIG 12 /r VMOVSLDUP xmm1, xmm2/m128 RM Z, R V V AVX vmovsldup Move even index single-precision floating-point values from xmm2/mem and duplicate each element into xmm1. +VEX.256.F3.0F.WIG 12 /r VMOVSLDUP ymm1, ymm2/m256 RM W, R V V AVX vmovsldup Move even index single-precision floating-point values from ymm2/mem and duplicate each element into ymm1. + +F3 0F 10 /r MOVSS xmm1, xmm2/m32 RM RW, R V V SSE movss YES Move scalar single-precision floating-point value from xmm2/m32 to xmm1 register. +VEX.NDS.LIG.F3.0F.WIG 10 /r VMOVSS xmm1, xmm2, xmm3 RVM Z, R, R V V AVX vmovss Merge scalar single-precision floating-point value from xmm2 and xmm3 to xmm1 register. +VEX.LIG.F3.0F.WIG 10 /r VMOVSS xmm1, m32 XM Z, R V V AVX vmovss Load scalar single-precision floating-point value from m32 to xmm1 register. +F3 0F 11 /r MOVSS xmm2/m32, xmm MR QW, R V V SSE movss Move scalar single-precision floating-point value from xmm1 register to xmm2/m32. +VEX.NDS.LIG.F3.0F.WIG 11 /r VMOVSS xmm1, xmm2, xmm3 MVR Z, R, R V V AVX vmovss YES Move scalar single-precision floating-point value from xmm2 and xmm3 to xmm1 register. +VEX.LIG.F3.0F.WIG 11 /r VMOVSS m32, xmm1 MR W, R V V AVX vmovss Move scalar single-precision floating-point value from xmm1 register to m32. + +0F BE /r MOVSX r16, r/m8 RM W, R V V movsbw Move byte to word with sign-extension. +REX+ 0F BE /r MOVSX r16, r/m8 RM W, R V V movsbw Move byte to word with sign-extension. +0F BE /r MOVSX r32, r/m8 RM W, R V V movsbl Move byte to doubleword with sign-extension. +REX+ 0F BE /r MOVSX r32, r/m8 RM W, R V V movsbl Move byte to doubleword with sign-extension. +REX.W+ 0F BE /r MOVSX r64, r/m8 RM W, R V NE movsbq Move byte to quadword with sign-extension. +0F BF /r MOVSX r32, r/m16 RM W, R V V movswl Move word to doubleword, with sign-extension. +REX.W+ 0F BF /r MOVSX r64, r/m16 RM W, R V NE movswq Move word to quadword with sign-extension. +REX.W+ 63 /r MOVSXD r64, r/m32 RM W, R V NE movslq Move doubleword to quadword with sign-extension. + +66 0F 10 /r MOVUPD xmm1, xmm2/m128 RM W, R V V SSE2 movupd YES Move packed double-precision floating-point values from xmm2/m128 to xmm1. +VEX.128.66.0F.WIG 10 /r VMOVUPD xmm1, xmm2/m128 RM Z, R V V AVX vmovupd Move unaligned packed double-precision floating-point from xmm2/mem to xmm1. +VEX.256.66.0F.WIG 10 /r VMOVUPD ymm1, ymm2/m256 RM W, R V V AVX vmovupd Move unaligned packed double-precision floating-point from ymm2/mem to ymm1. +66 0F 11 /r MOVUPD xmm2/m128, xmm MR W, R V V SSE2 movupd Move packed double-precision floating-point values from xmm1 to xmm2/m128. +VEX.128.66.0F.WIG 11 /r VMOVUPD xmm2/m128, xmm1 MR Z, R V V AVX vmovupd YES Move unaligned packed double-precision floating-point from xmm1 to xmm2/mem. +VEX.256.66.0F.WIG 11 /r VMOVUPD ymm2/m256, ymm1 MR W, R V V AVX vmovupd YES Move unaligned packed double-precision floating-point from ymm1 to ymm2/mem. + +0F 10 /r MOVUPS xmm1, xmm2/m128 RM W, R V V SSE movups YES Move packed single-precision floating-point values from xmm2/m128 to xmm1. +VEX.128.0F.WIG 10 /r VMOVUPS xmm1, xmm2/m128 RM Z, R V V AVX vmovups Move unaligned packed single-precision floating-point from xmm2/mem to xmm1. +VEX.256.0F.WIG 10 /r VMOVUPS ymm1, ymm2/m256 RM W, R V V AVX vmovups Move unaligned packed single-precision floating-point from ymm2/mem to ymm1. +0F 11 /r MOVUPS xmm2/m128, xmm1 MR W, R V V SSE movups Move packed single-precision floating-point values from xmm1 to xmm2/m128. +VEX.128.0F.WIG 11 /r VMOVUPS xmm2/m128, xmm1 MR Z, R V V AVX vmovups YES Move unaligned packed single-precision floating-point from xmm1 to xmm2/mem. +VEX.256.0F.WIG 11 /r VMOVUPS ymm2/m256, ymm1 MR W, R V V AVX vmovups YES Move unaligned packed single-precision floating-point from ymm1 to ymm2/mem. + +0F B6 /r MOVZX r16, r/m8 RM W, R V V movzbw Move byte to word with zero-extension. +REX+ 0F B6 /r MOVZX r16, r/m8 RM W, R V V movzbw Move byte to word with zero-extension. +0F B6 /r MOVZX r32, r/m8 RM W, R V V movzbl Move byte to doubleword, zero-extension. +REX+ 0F B6 /r MOVZX r32, r/m8 RM W, R V V movzbl Move byte to doubleword, zero-extension. +REX.W+ 0F B6 /r MOVZX r64, r/m8 RM W, R V NE movzbq Move byte to quadword, zero-extension. +0F B7 /r MOVZX r32, r/m16 RM W, R V V movzwl Move word to doubleword, zero-extension. +REX.W+ 0F B7 /r MOVZX r64, r/m16 RM W, R V NE movzwq Move word to quadword, zero-extension. + +66 0F 3A 42 /r ib MPSADBW xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSE4_1 mpsadbw Sums absolute 8-bit integer difference of adjacent groups of 4 byte integers in xmm1 and xmm2/m128 and writes the results in xmm1. Starting offsets within xmm1 and xmm2/m128 are determined by imm8. +VEX.NDS.128.66.0F3A.WIG 42 /r ib VMPSADBW xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vmpsadbw Sums absolute 8-bit integer difference of adjacent groups of 4 byte integers in xmm2 and xmm3/m128 and writes the results in xmm1. Starting offsets within xmm2 and xmm3/m128 are determined by imm8. +VEX.NDS.256.66.0F3A.WIG 42 /r ib VMPSADBW ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX2 vmpsadbw Sums absolute 8-bit integer difference of adjacent groups of 4 byte integers in xmm2 and ymm3/m128 and writes the results in ymm1. Starting offsets within ymm2 and xmm3/m128 are determined by imm8. + +F6 /4 MUL r/m8 M R AL AX E.OF E.CF E.SF E.ZF E.AF E.PF V V mulb Unsigned multiply (AX = AL * r/m8). +REX+ F6 /4 MUL r/m8 M R AL AX E.OF E.CF E.SF E.ZF E.AF E.PF V NE mulb Unsigned multiply (AX = AL * r/m8). +F7 /4 MUL r/m16 M R AX AX DX E.OF E.CF E.SF E.ZF E.AF E.PF V V mulw Unsigned multiply (DX:AX = AX * r/m16). +F7 /4 MUL r/m32 M R EAX RAX RDX E.OF E.CF E.SF E.ZF E.AF E.PF V V mull Unsigned multiply (EDX:EAX = EAX * r/m32). +REX.W+ F7 /4 MUL r/m64 M R RAX RAX RDX E.OF E.CF E.SF E.ZF E.AF E.PF V NE mulq Unsigned multiply (RDX:RAX = RAX * r/m64. + +66 0F 59 /r MULPD xmm1, xmm2/m128 RM RW, R V V SSE2 mulpd Multiply packed double-precision floating-point values in xmm2/m128 by xmm1. +VEX.NDS.128.66.0F.WIG 59 /r VMULPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vmulpd Multiply packed double-precision floating-point values from xmm3/mem to xmm2 and stores result in xmm1. +VEX.NDS.256.66.0F.WIG 59 /r VMULPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vmulpd Multiply packed double-precision floating-point values from ymm3/mem to ymm2 and stores result in ymm1. + +0F 59 /r MULPS xmm1, xmm2/m128 RM RW, R V V SSE mulps Multiply packed single-precision floating-point values in xmm2/mem by xmm1. +VEX.NDS.128.0F.WIG 59 /r VMULPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vmulps Multiply packed single-precision floating-point values from xmm3/mem to xmm2 and stores result in xmm1. +VEX.NDS.256.0F.WIG 59 /r VMULPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vmulps Multiply packed single-precision floating-point values from ymm3/mem to ymm2 and stores result in ymm1. + +F2 0F 59 /r MULSD xmm1, xmm2/m64 RM RW, R V V SSE2 mulsd Multiply the low double-precision floating-point value in xmm2/mem64 by low double-precision floating-point value in xmm1. +VEX.NDS.LIG.F2.0F.WIG 59 /r VMULSD xmm1,xmm2, xmm3/m64 RVM Z, R, R V V AVX vmulsd Multiply the low double-precision floating-point value in xmm3/mem64 by low double precision floating-point value in xmm2. + +F3 0F 59 /r MULSS xmm1, xmm2/m32 RM RW, R V V SSE mulss Multiply the low single-precision floating-point value in xmm2/mem by the low single-precision floating-point value in xmm1. +VEX.NDS.LIG.F3.0F.WIG 59 /r VMULSS xmm1,xmm2, xmm3/m32 RVM Z, R, R V V AVX vmulss Multiply the low single-precision floating-point value in xmm3/mem by the low single-precision floating-point value in xmm2. + +VEX.NDD.LZ.F2.0F38.W0 F6 /r MULX r32a, r32b, r/m32 RVM W, W, R EDX V V BMI2 mulxl Unsigned multiply of r/m32 with EDX without affecting arithmetic flags +VEX.NDD.LZ.F2.0F38.W1 F6 /r MULX r64a, r64b, r/m64 RVM W, W, R RDX V NE BMI2 mulxq Unsigned multiply of r/m64 with RDX without affecting arithmetic flags + +0F 01 C9 MWAIT NP EAX ECX V V MONITOR mwait A hint that allow the processor to stop instruction execution and enter an implementation-dependent optimized state until occurrence of a class of events. + +F6 /3 NEG r/m8 M RW E.CF E.OF E.SF E.ZF E.AF E.PF V V negb Two''s complement negate r/m8. +REX+ F6 /3 NEG r/m8 M RW E.CF E.OF E.SF E.ZF E.AF E.PF V NE negb Two''s complement negate r/m8. +F7 /3 NEG r/m16 M RW E.CF E.OF E.SF E.ZF E.AF E.PF V V negw Two''s complement negate r/m16. +F7 /3 NEG r/m32 M RW E.CF E.OF E.SF E.ZF E.AF E.PF V V negl Two''s complement negate r/m32. +REX.W+ F7 /3 NEG r/m64 M RW E.CF E.OF E.SF E.ZF E.AF E.PF V NE negq Two''s complement negate r/m64. + +90 NOP NP V V nop One byte no-operation instruction. +0F 1F /0 NOP r/m16 M I V V NOPL nopw Multi-byte no-operation instruction. +0F 1F /0 NOP r/m32 M I V V NOPL nopl Multi-byte no-operation instruction. + +F6 /2 NOT r/m8 M RW V V notb Reverse each bit of r/m8. +REX+ F6 /2 NOT r/m8 M RW V NE notb Reverse each bit of r/m8. +F7 /2 NOT r/m16 M RW V V notw Reverse each bit of r/m16. +F7 /2 NOT r/m32 M RW V V notl Reverse each bit of r/m32. +REX.W+ F7 /2 NOT r/m64 M RW V NE notq Reverse each bit of r/m64. + +0C ib OR AL, imm8 I RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orb AL OR imm8. +0D iw OR AX, imm16 I RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orw AX OR imm16. +0D id OR EAX, imm32 I RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orl EAX OR imm32. +REX.W+ 0D id OR RAX, imm32 I RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE orq RAX OR imm32 (sign-extended). +80 /1 ib OR r/m8, imm8 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orb r/m8 OR imm8. +REX+ 80 /1 ib OR r/m8, imm8 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE orb r/m8 OR imm8. +81 /1 iw OR r/m16, imm16 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orw r/m16 OR imm16. +81 /1 id OR r/m32, imm32 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orl r/m32 OR imm32. +REX.W+ 81 /1 id OR r/m64, imm32 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE orq r/m64 OR imm32 (sign-extended). +83 /1 ib OR r/m16, imm8 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orw YES r/m16 OR imm8 (sign-extended). +83 /1 ib OR r/m32, imm8 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orl YES r/m32 OR imm8 (sign-extended). +REX.W+ 83 /1 ib OR r/m64, imm8 MI RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE orq YES r/m64 OR imm8 (sign-extended). +08 /r OR r/m8, r8 MR RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orb YES r/m8 OR r8. +REX+ 08 /r OR r/m8, r8 MR RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE orb YES r/m8 OR r8. +09 /r OR r/m16, r16 MR RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orw YES r/m16 OR r16. +09 /r OR r/m32, r32 MR RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orl YES r/m32 OR r32. +REX.W+ 09 /r OR r/m64, r64 MR RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE orq YES r/m64 OR r64. +0A /r OR r8, r/m8 RM RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orb r8 OR r/m8. +REX+ 0A /r OR r8, r/m8 RM RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE orb r8 OR r/m8. +0B /r OR r16, r/m16 RM RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orw r16 OR r/m16. +0B /r OR r32, r/m32 RM RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V V orl r32 OR r/m32. +REX.W+ 0B /r OR r64, r/m64 RM RW, R E.OF E.CF E.SF E.ZF E.PF E.AF V NE orq r64 OR r/m64. + +66 0F 56 /r ORPD xmm1, xmm2/m128 RM RW, R V V SSE2 orpd Bitwise OR of xmm2/m128 and xmm1. +VEX.NDS.128.66.0F.WIG 56 /r VORPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vorpd Return the bitwise logical OR of packed double-precision floating-point values in xmm2 and xmm3/mem. +VEX.NDS.256.66.0F.WIG 56 /r VORPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vorpd Return the bitwise logical OR of packed double-precision floating-point values in ymm2 and ymm3/mem. + +0F 56 /r ORPS xmm1, xmm2/m128 RM RW, R V V SSE orps Bitwise OR of xmm1 and xmm2/m128. +VEX.NDS.128.0F.WIG 56 /r VORPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vorps Return the bitwise logical OR of packed single-precision floating-point values in xmm2 and xmm3/mem. +VEX.NDS.256.0F.WIG 56 /r VORPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vorps Return the bitwise logical OR of packed single-precision floating-point values in ymm2 and ymm3/mem. + +E6 ib OUT imm8, AL I R, R E.IOPL E.VM V V outb Output byte in AL to I/O port address imm8. +E7 ib OUT imm8, AX I R, R E.IOPL E.VM V V outw Output word in AX to I/O port address imm8. +E7 ib OUT imm8, EAX I R, R E.IOPL E.VM V V outl Output doubleword in EAX to I/O port address imm8. +EE OUT DX, AL NP R, R E.IOPL E.VM V V outb Output byte in AL to I/O port address in DX. +EF OUT DX, AX NP R, R E.IOPL E.VM V V outw Output word in AX to I/O port address in DX. +EF OUT DX, EAX NP R, R E.IOPL E.VM V V outl Output doubleword in EAX to I/O port address in DX. + +6E OUTS DX, m8 NP R, I E.IOPL E.VM E.DF RSI V V outs Output byte from memory location specified in DS:(E)SI or RSI to I/O port specified in DX. +6F OUTS DX, m16 NP R, I E.IOPL E.VM E.DF RSI V V outs Output word from memory location specified in DS:(E)SI or RSI to I/O port specified in DX. +6F OUTS DX, m32 NP R, I E.IOPL E.VM E.DF RSI V V outs Output doubleword from memory location specified in DS:(E)SI or RSI to I/O port specified in DX. +6E OUTSB NP E.IOPL E.VM E.DF DX RSI V V outsb Output byte from memory location specified in DS:(E)SI or RSI to I/O port specified in DX. +PREF.66+ 6F OUTSW NP E.IOPL E.VM E.DF DX RSI V V outsw Output word from memory location specified in DS:(E)SI or RSI to I/O port specified in DX. +6F OUTSD NP E.IOPL E.VM E.DF DX RSI V V outsl Output doubleword from memory location specified in DS:(E)SI or RSI to I/O port specified in DX. + +0F 38 1C /r PABSB mm1, mm2/m64 RM W, R V V SSSE3 pabsb Compute the absolute value of bytes in mm2/m64 and store UNSIGNED result in mm1. +66 0F 38 1C /r PABSB xmm1, xmm2/m128 RM W, R V V SSSE3 pabsb Compute the absolute value of bytes in xmm2/m128 and store UNSIGNED result in xmm1. +0F 38 1D /r PABSW mm1, mm2/m64 RM W, R V V SSSE3 pabsw Compute the absolute value of 16-bit integers in mm2/m64 and store UNSIGNED result in mm1. +66 0F 38 1D /r PABSW xmm1, xmm2/m128 RM W, R V V SSSE3 pabsw Compute the absolute value of 16-bit integers in xmm2/m128 and store UNSIGNED result in xmm1. +0F 38 1E /r PABSD mm1, mm2/m64 RM W, R V V SSSE3 pabsd Compute the absolute value of 32-bit integers in mm2/m64 and store UNSIGNED result in mm1. +66 0F 38 1E /r PABSD xmm1, xmm2/m128 RM W, R V V SSSE3 pabsd Compute the absolute value of 32-bit integers in xmm2/m128 and store UNSIGNED result in xmm1. +VEX.128.66.0F38.WIG 1C /r VPABSB xmm1, xmm2/m128 RM Z, R V V AVX vpabsb Compute the absolute value of bytes in xmm2/m128 and store UNSIGNED result in xmm1. +VEX.128.66.0F38.WIG 1D /r VPABSW xmm1, xmm2/m128 RM Z, R V V AVX vpabsw Compute the absolute value of 16- bit integers in xmm2/m128 and store UNSIGNED result in xmm1. +VEX.128.66.0F38.WIG 1E /r VPABSD xmm1, xmm2/m128 RM Z, R V V AVX vpabsd Compute the absolute value of 32- bit integers in xmm2/m128 and store UNSIGNED result in xmm1. +VEX.256.66.0F38.WIG 1C /r VPABSB ymm1, ymm2/m256 RM W, R V V AVX2 vpabsb Compute the absolute value of bytes in ymm2/m256 and store UNSIGNED result in ymm1. +VEX.256.66.0F38.WIG 1D /r VPABSW ymm1, ymm2/m256 RM W, R V V AVX2 vpabsw Compute the absolute value of 16-bit integers in ymm2/m256 and store UNSIGNED result in ymm1 +VEX.256.66.0F38.WIG 1E /r VPABSD ymm1, ymm2/m256 RM W, R V V AVX2 vpabsd Compute the absolute value of 32-bit integers in ymm2/m256 and store UNSIGNED result in ymm1. + +0F 63 /r PACKSSWB mm1, mm2/m64 RM RW, R V V MMX packsswb Converts 4 packed signed word integers from mm1 and from mm2/m64 into 8 packed signed byte integers in mm1 using signed saturation. +66 0F 63 /r PACKSSWB xmm1, xmm2/m128 RM RW, R V V SSE2 packsswb Converts 8 packed signed word integers from xmm1 and from xxm2/m128 into 16 packed signed byte integers in xxm1 using signed saturation. +0F 6B /r PACKSSDW mm1, mm2/m64 RM RW, R V V MMX packssdw Converts 2 packed signed doubleword integers from mm1 and from mm2/m64 into 4 packed signed word integers in mm1 using signed saturation. +66 0F 6B /r PACKSSDW xmm1, xmm2/m128 RM RW, R V V SSE2 packssdw Converts 4 packed signed doubleword integers from xmm1 and from xxm2/m128 into 8 packed signed word integers in xxm1 using signed saturation. +VEX.NDS.128.66.0F.WIG 63 /r VPACKSSWB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpacksswb Converts 8 packed signed word integers from xmm2 and from xmm3/m128 into 16 packed signed byte integers in xmm1 using signed saturation. +VEX.NDS.128.66.0F.WIG 6B /r VPACKSSDW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpackssdw Converts 4 packed signed doubleword integers from xmm2 and from xmm3/m128 into 8 packed signed word integers in xmm1 using signed saturation. +VEX.NDS.256.66.0F.WIG 63 /r VPACKSSWB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpacksswb Converts 16 packed signed word integers from ymm2 and from ymm3/m256 into 32 packed signed byte integers in ymm1 using signed saturation. +VEX.NDS.256.66.0F.WIG 6B /r VPACKSSDW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpackssdw Converts 8 packed signed doubleword integers from ymm2 and from ymm3/m256 into 16 packed signed word integers in ymm1using signed saturation. + +66 0F 38 2B /r PACKUSDW xmm1, xmm2/m128 RM RW, R V V SSE4_1 packusdw Convert 4 packed signed doubleword integers from xmm1 and 4 packed signed doubleword integers from xmm2/m128 into 8 packed unsigned word integers in xmm1 using unsigned saturation. +VEX.NDS.128.66.0F38.WIG 2B /r VPACKUSDW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpackusdw Convert 4 packed signed doubleword integers from xmm2 and 4 packed signed doubleword integers from xmm3/m128 into 8 packed unsigned word integers in xmm1 using unsigned saturation. +VEX.NDS.256.66.0F38.WIG 2B /r VPACKUSDW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpackusdw Convert 8 packed signed doubleword integers from ymm2 and 8 packed signed doubleword integers from ymm3/m128 into 16 packed unsigned word integers in ymm1 using unsigned saturation. + +0F 67 /r PACKUSWB mm, mm/m64 RM RW, R V V MMX packuswb Converts 4 signed word integers from mm and 4 signed word integers from mm/m64 into 8 unsigned byte integers in mm using unsigned saturation. +66 0F 67 /r PACKUSWB xmm1, xmm2/m128 RM RW, R V V SSE2 packuswb Converts 8 signed word integers from xmm1 and 8 signed word integers from xmm2/m128 into 16 unsigned byte integers in xmm1 using unsigned saturation. +VEX.NDS.128.66.0F.WIG 67 /r VPACKUSWB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpackuswb Converts 8 signed word integers from xmm2 and 8 signed word integers from xmm3/m128 into 16 unsigned byte integers in xmm1 using unsigned saturation. +VEX.NDS.256.66.0F.WIG 67 /r VPACKUSWB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpackuswb Converts 16 signed word integers from ymm2 And 16 signed word integers from ymm3/m256 into 32 unsigned byte integers in ymm1 using unsigned saturation. + +0F FC /r PADDB mm, mm/m64 RM RW, R V V MMX paddb Add packed byte integers from mm/m64 and mm. +66 0F FC /r PADDB xmm1, xmm2/m128 RM RW, R V V SSE2 paddb Add packed byte integers from xmm2/m128 and xmm1. +0F FD /r PADDW mm, mm/m64 RM RW, R V V MMX paddw Add packed word integers from mm/m64 and mm. +66 0F FD /r PADDW xmm1, xmm2/m128 RM RW, R V V SSE2 paddw Add packed word integers from xmm2/m128 and xmm1. +0F FE /r PADDD mm, mm/m64 RM RW, R V V MMX paddd Add packed doubleword integers from mm/m64 and mm. +66 0F FE /r PADDD xmm1, xmm2/m128 RM RW, R V V SSE2 paddd Add packed doubleword integers from xmm2/m128 and xmm1. +VEX.NDS.128.66.0F.WIG FC /r VPADDB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpaddb Add packed byte integers from xmm3/m128 and xmm2. +VEX.NDS.128.66.0F.WIG FD /r VPADDW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpaddw Add packed word integers from xmm3/m128 and xmm2. +VEX.NDS.128.66.0F.WIG FE /r VPADDD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpaddd Add packed doubleword integers from xmm3/m128 and xmm2. +VEX.NDS.256.66.0F.WIG FC /r VPADDB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpaddb Add packed byte integers from ymm2, and ymm3/m256 and store in ymm1. +VEX.NDS.256.66.0F.WIG FD /r VPADDW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpaddw Add packed word integers from ymm2, ymm3/m256 and store in ymm1. +VEX.NDS.256.66.0F.WIG FE /r VPADDD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpaddd Add packed doubleword integers from ymm2, ymm3/m256 and store in ymm1. + +0F D4 /r PADDQ mm1, mm2/m64 RM RW, R V V SSE2 paddq Add quadword integer mm2/m64 to mm1. +66 0F D4 /r PADDQ xmm1, xmm2/m128 RM RW, R V V SSE2 paddq Add packed quadword integers xmm2/m128 to xmm1. +VEX.NDS.128.66.0F.WIG D4 /r VPADDQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpaddq Add packed quadword integers xmm3/m128 and xmm2. +VEX.NDS.256.66.0F.WIG D4 /r VPADDQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpaddq Add packed quadword integers from ymm2, ymm3/m256 and store in ymm1. + +0F EC /r PADDSB mm, mm/m64 RM RW, R V V MMX paddsb Add packed signed byte integers from mm/m64 and mm and saturate the results. +66 0F EC /r PADDSB xmm1, xmm2/m128 RM RW, R V V SSE2 paddsb Add packed signed byte integers from xmm2/m128 and xmm1 saturate the results. +0F ED /r PADDSW mm, mm/m64 RM RW, R V V MMX paddsw Add packed signed word integers from mm/m64 and mm and saturate the results. +66 0F ED /r PADDSW xmm1, xmm2/m128 RM RW, R V V SSE2 paddsw Add packed signed word integers from xmm2/m128 and xmm1 and saturate the results. +VEX.NDS.128.66.0F.WIG EC /r VPADDSB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpaddsb Add packed signed byte integers from xmm3/m128 and xmm2 saturate the results. +VEX.NDS.128.66.0F.WIG ED /r VPADDSW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpaddsw Add packed signed word integers from xmm3/m128 and xmm2 and saturate the results. +VEX.NDS.256.66.0F.WIG EC /r VPADDSB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpaddsb Add packed signed byte integers from ymm2, and ymm3/m256 and store the saturated results in ymm1. +VEX.NDS.256.66.0F.WIG ED /r VPADDSW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpaddsw Add packed signed word integers from ymm2, and ymm3/m256 and store the saturated results in ymm1. + +0F DC /r PADDUSB mm, mm/m64 RM RW, R V V MMX paddusb Add packed unsigned byte integers from mm/m64 and mm and saturate the results. +66 0F DC /r PADDUSB xmm1, xmm2/m128 RM RW, R V V SSE2 paddusb Add packed unsigned byte integers from xmm2/m128 and xmm1 saturate the results. +0F DD /r PADDUSW mm, mm/m64 RM RW, R V V MMX paddusw Add packed unsigned word integers from mm/m64 and mm and saturate the results. +66 0F DD /r PADDUSW xmm1, xmm2/m128 RM RW, R V V SSE2 paddusw Add packed unsigned word integers from xmm2/m128 to xmm1 and saturate the results. +VEX.NDS.128.66.0F.WIG DC /r VPADDUSB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpaddusb Add packed unsigned byte integers from xmm3/m128 to xmm2 and saturate the results. +VEX.NDS.128.66.0F.WIG DD /r VPADDUSW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpaddusw Add packed unsigned word integers from xmm3/m128 to xmm2 and saturate the results. +VEX.NDS.256.66.0F.WIG DC /r VPADDUSB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpaddusb Add packed unsigned byte integers from ymm2, and ymm3/m256 and store the saturated results in ymm1. +VEX.NDS.256.66.0F.WIG DD /r VPADDUSW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpaddusw Add packed unsigned word integers from ymm2, and ymm3/m256 and store the saturated results in ymm1. + +0F 3A 0F PALIGNR mm1, mm2/m64, imm8 RMI RW, R, R V V SSSE3 palignr Concatenate destination and source operands, extract byte-aligned result shifted to the right by constant value in imm8 into mm1. +66 0F 3A 0F PALIGNR xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSSE3 palignr Concatenate destination and source operands, extract byte-aligned result shifted to the right by constant value in imm8 into xmm1 +VEX.NDS.128.66.0F3A.WIG 0F /r ib VPALIGNR xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vpalignr Concatenate xmm2 and xmm3/m128, extract byte aligned result shifted to the right by constant value in imm8 and result is stored in xmm1. +VEX.NDS.256.66.0F3A.WIG 0F /r ib VPALIGNR ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX2 vpalignr Concatenate pairs of 16 bytes in ymm2 and ymm3/m256 into 32-byte intermediate result, extract byte-aligned, 16-byte result shifted to the right by constant values in imm8 from each intermediate result, and two 16-byte results are stored in ymm1. + +0F DB /r PAND mm, mm/m64 RM RW, R V V MMX pand Bitwise AND mm/m64 and mm. +66 0F DB /r PAND xmm1, xmm2/m128 RM RW, R V V SSE2 pand Bitwise AND of xmm2/m128 and xmm1. +VEX.NDS.128.66.0F.WIG DB /r VPAND xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpand Bitwise AND of xmm3/m128 and xmm. +VEX.NDS.256.66.0F.WIG DB /r VPAND ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpand Bitwise AND of ymm2, and ymm3/m256 and store result in ymm1. + +0F DF /r PANDN mm, mm/m64 RM RW, R V V MMX pandn Bitwise AND NOT of mm/m64 and mm. +66 0F DF /r PANDN xmm1, xmm2/m128 RM RW, R V V SSE2 pandn Bitwise AND NOT of xmm2/m128 and xmm1. +VEX.NDS.128.66.0F.WIG DF /r VPANDN xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpandn Bitwise AND NOT of xmm3/m128 and xmm2. +VEX.NDS.256.66.0F.WIG DF /r VPANDN ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpandn Bitwise AND NOT of ymm2, and ymm3/m256 and store result in ymm1. + +F3 90 PAUSE NP V V pause Gives hint to processor that improves performance of spin-wait loops. + +0F E0 /r PAVGB mm1, mm2/m64 RM RW, R V V SSE pavgb Average packed unsigned byte integers from mm2/m64 and mm1 with rounding. +66 0F E0 /r PAVGB xmm1, xmm2/m128 RM RW, R V V SSE2 pavgb Average packed unsigned byte integers from xmm2/m128 and xmm1 with rounding. +0F E3 /r PAVGW mm1, mm2/m64 RM RW, R V V SSE pavgw Average packed unsigned word integers from mm2/m64 and mm1 with rounding. +66 0F E3 /r PAVGW xmm1, xmm2/m128 RM RW, R V V SSE2 pavgw Average packed unsigned word integers from xmm2/m128 and xmm1 with rounding. +VEX.NDS.128.66.0F.WIG E0 /r VPAVGB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpavgb Average packed unsigned byte integers from xmm3/m128 and xmm2 with rounding. +VEX.NDS.128.66.0F.WIG E3 /r VPAVGW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpavgw Average packed unsigned word integers from xmm3/m128 and xmm2 with rounding. +VEX.NDS.256.66.0F.WIG E0 /r VPAVGB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpavgb Average packed unsigned byte integers from ymm2, and ymm3/m256 with rounding and store to ymm1. +VEX.NDS.256.66.0F.WIG E3 /r VPAVGW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpavgw Average packed unsigned word integers from ymm2, ymm3/m256 with rounding to ymm1. + +66 0F 38 10 /r PBLENDVB xmm1, xmm2/m128, RM RW, R, R V V SSE4_1 pblendvb Select byte values from xmm1 and xmm2/m128 from mask specified in the high bit of each byte in XMM0 and store the values into xmm1. +VEX.NDS.128.66.0F3A.W0 4C /r /is4 VPBLENDVB xmm1, xmm2, xmm3/m128, xmm4 RVMR Z, R, R, R V V AVX vpblendvb Select byte values from xmm2 and xmm3/m128 using mask bits in the specified mask register, xmm4, and store the values into xmm1. +VEX.NDS.256.66.0F3A.W0 4C /r /is4 VPBLENDVB ymm1, ymm2, ymm3/m256, ymm4 RVMR W, R, R, R V V AVX2 vpblendvb Select byte values from ymm2 and ymm3/m256 from mask specified in the high bit of each byte in ymm4 and store the values into ymm1. + +66 0F 3A 0E /r ib PBLENDW xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSE4_1 pblendw Select words from xmm1 and xmm2/m128 from mask specified in imm8 and store the values into xmm1. +VEX.NDS.128.66.0F3A.WIG 0E /r ib VPBLENDW xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vpblendw Select words from xmm2 and xmm3/m128 from mask specified in imm8 and store the values into xmm1. +VEX.NDS.256.66.0F3A.WIG 0E /r ib VPBLENDW ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX2 vpblendw Select words from ymm2 and ymm3/m256 from mask specified in imm8 and store the values into ymm1. + +66 0F 3A 44 /r ib PCLMULQDQ xmm1, xmm2/m128, imm8 RMI RW, R, R V V PCLMULQDQ pclmulqdq Carry-less multiplication of one quadword of xmm1 by one quadword of xmm2/m128, stores the 128-bit result in xmm1. The immediate is used to determine which quadwords of xmm1 and xmm2/m128 should be used. +VEX.NDS.128.66.0F3A.WIG 44 /r ib VPCLMULQDQ xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V PCLMULQDQ AVX vpclmulqdq Carry-less multiplication of one quadword of xmm2 by one quadword of xmm3/m128, stores the 128-bit result in xmm1. The immediate is used to determine which quadwords of xmm2 and xmm3/m128 should be used. + +0F 74 /r PCMPEQB mm, mm/m64 RM RW, R V V MMX pcmpeqb Compare packed bytes in mm/m64 and mm for equality. +66 0F 74 /r PCMPEQB xmm1, xmm2/m128 RM RW, R V V SSE2 pcmpeqb Compare packed bytes in xmm2/m128 and xmm1 for equality. +0F 75 /r PCMPEQW mm, mm/m64 RM RW, R V V MMX pcmpeqw Compare packed words in mm/m64 and mm for equality. +66 0F 75 /r PCMPEQW xmm1, xmm2/m128 RM RW, R V V SSE2 pcmpeqw Compare packed words in xmm2/m128 and xmm1 for equality. +0F 76 /r PCMPEQD mm, mm/m64 RM RW, R V V MMX pcmpeqd Compare packed doublewords in mm/m64 and mm for equality. +66 0F 76 /r PCMPEQD xmm1, xmm2/m128 RM RW, R V V SSE2 pcmpeqd Compare packed doublewords in xmm2/m128 and xmm1 for equality. +VEX.NDS.128.66.0F.WIG 74 /r VPCMPEQB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpcmpeqb Compare packed bytes in xmm3/m128 and xmm2 for equality. +VEX.NDS.128.66.0F.WIG 75 /r VPCMPEQW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpcmpeqw Compare packed words in xmm3/m128 and xmm2 for equality. +VEX.NDS.128.66.0F.WIG 76 /r VPCMPEQD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpcmpeqd Compare packed doublewords in xmm3/m128 and xmm2 for equality. +VEX.NDS.256.66.0F.WIG 74 /r VPCMPEQB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpcmpeqb Compare packed bytes in ymm3/m256 and ymm2 for equality. +VEX.NDS.256.66.0F.WIG 75 /r VPCMPEQW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpcmpeqw Compare packed words in ymm3/m256 and ymm2 for equality. +VEX.NDS.256.66.0F.WIG 76 /r VPCMPEQD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpcmpeqd Compare packed doublewords in ymm3/m256 and ymm2 for equality. + +66 0F 38 29 /r PCMPEQQ xmm1, xmm2/m128 RM RW, R V V SSE4_1 pcmpeqq Compare packed qwords in xmm2/m128 and xmm1 for equality. +VEX.NDS.128.66.0F38.WIG 29 /r VPCMPEQQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpcmpeqq Compare packed quadwords in xmm3/m128 and xmm2 for equality. +VEX.NDS.256.66.0F38.WIG 29 /r VPCMPEQQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpcmpeqq Compare packed quadwords in ymm3/m256 and ymm2 for equality. + +66 0F 3A 61 /r PCMPESTRI xmm1, xmm2/m128, imm8 RMI R, R, R EAX EDX RCX E.CF E.ZF E.SF E.OF E.AF E.PF V V SSE4_2 pcmpestri Perform a packed comparison of string data with explicit lengths, generating an index, and storing the result in ECX. +VEX.128.66.0F3A.WIG 61 /r ib VPCMPESTRI xmm1, xmm2/m128, imm8 RMI R, R, R EAX EDX RCX E.CF E.ZF E.SF E.OF E.AF E.PF V V AVX vpcmpestri Perform a packed comparison of string data with explicit lengths, generating an index, and storing the result in ECX. + +66 0F 3A 60 /r PCMPESTRM xmm1, xmm2/m128, imm8 RMI R, R, R EAX EDX XMM0 E.CF E.ZF E.SF E.OF E.AF E.PF V V SSE4_2 pcmpestrm Perform a packed comparison of string data with explicit lengths, generating a mask, and storing the result in XMM0 +VEX.128.66.0F3A.WIG 60 /r ib VPCMPESTRM xmm1, xmm2/m128, imm8 RMI R, R, R EAX EDX YMM0 E.CF E.ZF E.SF E.OF E.AF E.PF V V AVX vpcmpestrm Perform a packed comparison of string data with explicit lengths, generating a mask, and storing the result in XMM0. + +0F 64 /r PCMPGTB mm, mm/m64 RM RW, R V V MMX pcmpgtb Compare packed signed byte integers in mm and mm/m64 for greater than. +66 0F 64 /r PCMPGTB xmm1, xmm2/m128 RM RW, R V V SSE2 pcmpgtb Compare packed signed byte integers in xmm1 and xmm2/m128 for greater than. +0F 65 /r PCMPGTW mm, mm/m64 RM RW, R V V MMX pcmpgtw Compare packed signed word integers in mm and mm/m64 for greater than. +66 0F 65 /r PCMPGTW xmm1, xmm2/m128 RM RW, R V V SSE2 pcmpgtw Compare packed signed word integers in xmm1 and xmm2/m128 for greater than. +0F 66 /r PCMPGTD mm, mm/m64 RM RW, R V V MMX pcmpgtd Compare packed signed doubleword integers in mm and mm/m64 for greater than. +66 0F 66 /r PCMPGTD xmm1, xmm2/m128 RM RW, R V V SSE2 pcmpgtd Compare packed signed doubleword integers in xmm1 and xmm2/m128 for greater than. +VEX.NDS.128.66.0F.WIG 64 /r VPCMPGTB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpcmpgtb Compare packed signed byte integers in xmm2 and xmm3/m128 for greater than. +VEX.NDS.128.66.0F.WIG 65 /r VPCMPGTW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpcmpgtw Compare packed signed word integers in xmm2 and xmm3/m128 for greater than. +VEX.NDS.128.66.0F.WIG 66 /r VPCMPGTD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpcmpgtd Compare packed signed doubleword integers in xmm2 and xmm3/m128 for greater than. +VEX.NDS.256.66.0F.WIG 64 /r VPCMPGTB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpcmpgtb Compare packed signed byte integers in ymm2 and ymm3/m256 for greater than. +VEX.NDS.256.66.0F.WIG 65 /r VPCMPGTW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpcmpgtw Compare packed signed word integers in ymm2 and ymm3/m256 for greater than. +VEX.NDS.256.66.0F.WIG 66 /r VPCMPGTD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpcmpgtd Compare packed signed doubleword integers in ymm2 and ymm3/m256 for greater than. + +66 0F 38 37 /r PCMPGTQ xmm1, xmm2/m128 RM RW, R V V SSE4_2 pcmpgtq Compare packed signed qwords in xmm2/m128 and xmm1 for greater than. +VEX.NDS.128.66.0F38.WIG 37 /r VPCMPGTQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpcmpgtq Compare packed signed qwords in xmm2 and xmm3/m128 for greater than. +VEX.NDS.256.66.0F38.WIG 37 /r VPCMPGTQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpcmpgtq Compare packed signed qwords in ymm2 and ymm3/m256 for greater than. + +66 0F 3A 63 /r PCMPISTRI xmm1, xmm2/m128, imm8 RM R, R, R RCX E.CF E.ZF E.SF E.OF E.AF E.PF V V SSE4_2 pcmpistri Perform a packed comparison of string data with implicit lengths, generating an index, and storing the result in ECX. +VEX.128.66.0F3A.WIG 63 /r ib VPCMPISTRI xmm1, xmm2/m128, imm8 RM R, R, R RCX E.CF E.ZF E.SF E.OF E.AF E.PF V V AVX vpcmpistri Perform a packed comparison of string data with implicit lengths, generating an index, and storing the result in ECX. + +66 0F 3A 62 /r PCMPISTRM xmm1, xmm2/m128, imm8 RM R, R, R XMM0 E.CF E.ZF E.SF E.OF E.AF E.PF V V SSE4_2 pcmpistrm Perform a packed comparison of string data with implicit lengths, generating a mask, and storing the result in XMM0. +VEX.128.66.0F3A.WIG 62 /r ib VPCMPISTRM xmm1, xmm2/m128, imm8 RM R, R, R YMM0 E.CF E.ZF E.SF E.OF E.AF E.PF V V AVX vpcmpistrm Perform a packed comparison of string data with implicit lengths, generating a Mask, and storing the result in XMM0. + +VEX.NDS.LZ.F2.0F38.W0 F5 /r PDEP r32a, r32b, r/m32 RVM W, R, R V V BMI2 pdepl Parallel deposit of bits from r32b using mask in r/m32, result is written to r32a. +VEX.NDS.LZ.F2.0F38.W1 F5 /r PDEP r64a, r64b, r/m64 RVM W, R, R V NE BMI2 pdepq Parallel deposit of bits from r64b using mask in r/m64, result is written to r64a. + +VEX.NDS.LZ.F3.0F38.W0 F5 /r PEXT r32a, r32b, r/m32 RVM W, R, R V V BMI2 pextl Parallel extract of bits from r32b using mask in r/m32, result is written to r32a. +VEX.NDS.LZ.F3.0F38.W1 F5 /r PEXT r64a, r64b, r/m64 RVM W, R, R V NE BMI2 pextq Parallel extract of bits from r64b using mask in r/m64, result is written to r64a. + +66 0F 3A 14 /r ib PEXTRB reg/m8, xmm2, imm8 MRI W, R, R V V SSE4_1 pextrb Extract a byte integer value from xmm2 at the source byte offset specified by imm8 into rreg or m8. The upper bits of r32 or r64 are zeroed. +66 0F 3A 16 /r ib PEXTRD r/m32, xmm2, imm8 MRI W, R, R V V SSE4_1 pextrd Extract a dword integer value from xmm2 at the source dword offset specified by imm8 into r/m32. +66 REX.W+ 0F 3A 16 /r ib PEXTRQ r/m64, xmm2, imm8 MRI W, R, R V NE SSE4_1 pextrq Extract a qword integer value from xmm2 at the source qword offset specified by imm8 into r/m64. +VEX.128.66.0F3A.W0 14 /r ib VPEXTRB reg/m8, xmm2, imm8 MRI W, R, R V V AVX vpextrb Extract a byte integer value from xmm2 at the source byte offset specified by imm8 into reg or m8. The upper bits of r64/r32 is filled with +VEX.128.66.0F3A.W0 16 /r ib VPEXTRD r32/m32, xmm2, imm8 MRI W, R, R V V AVX vpextrd Extract a dword integer value from xmm2 at the source dword offset specified by imm8 into r32/m32. +VEX.128.66.0F3A.W1 16 /r ib VPEXTRQ r64/m64, xmm2, imm8 MRI W, R, R V I AVX vpextrq Extract a qword integer value from xmm2 at the source dword offset specified by imm8 into r64/m64. + +0F C5 /r ib PEXTRW reg, mm, imm8 RMI W, R, R V V SSE pextrw Extract the word specified by imm8 from mm and move it to reg, bits 15-0. The upper bits of r32 or r64 is zeroed. +66 0F C5 /r ib PEXTRW reg, xmm, imm8 RMI W, R, R V V SSE2 pextrw YES Extract the word specified by imm8 from xmm and move it to reg, bits 15-0. The upper bits of r32 or r64 is zeroed. +66 0F 3A 15 /r ib PEXTRW reg/m16, xmm, imm8 MRI W, R, R V V SSE4_1 pextrw Extract the word specified by imm8 from xmm and copy it to lowest 16 bits of reg or m16. Zero-extend the result in the destination, r32 or r64. +VEX.128.66.0F.W0 C5 /r ib VPEXTRW reg, xmm1, imm8 RMI W, R, R V V AVX vpextrw YES Extract the word specified by imm8 from xmm1 and move it to reg, bits 15:0. Zero-extend the result. The upper bits of r64/r32 is filled with zeros. +VEX.128.66.0F3A.W0 15 /r ib VPEXTRW reg/m16, xmm2, imm8 MRI W, R, R V V AVX vpextrw Extract a word integer value from xmm2 at the source word offset specified by imm8 into reg or m16. The upper bits of r64/r32 is filled with zeros. + +0F 38 01 /r PHADDW mm1, mm2/m64 RM RW, R V V SSSE3 phaddw Add 16-bit integers horizontally, pack to MM1. +66 0F 38 01 /r PHADDW xmm1, xmm2/m128 RM RW, R V V SSSE3 phaddw Add 16-bit integers horizontally, pack to XMM1. +0F 38 02 /r PHADDD mm1, mm2/m64 RM RW, R V V SSSE3 phaddd Add 32-bit integers horizontally, pack to MM1. +66 0F 38 02 /r PHADDD xmm1, xmm2/m128 RM RW, R V V SSSE3 phaddd Add 32-bit integers horizontally, pack to XMM1. +VEX.NDS.128.66.0F38.WIG 01 /r VPHADDW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vphaddw Add 16-bit integers horizontally, pack to xmm1. +VEX.NDS.128.66.0F38.WIG 02 /r VPHADDD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vphaddd Add 32-bit integers horizontally, pack to xmm1. +VEX.NDS.256.66.0F38.WIG 01 /r VPHADDW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vphaddw Add 16-bit signed integers horizontally, pack to ymm1. +VEX.NDS.256.66.0F38.WIG 02 /r VPHADDD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vphaddd Add 32-bit signed integers horizontally, pack to ymm1. + +0F 38 03 /r PHADDSW mm1, mm2/m64 RM RW, R V V SSSE3 phaddsw Add 16-bit signed integers horizontally, pack saturated integers to MM1. +66 0F 38 03 /r PHADDSW xmm1, xmm2/m128 RM RW, R V V SSSE3 phaddsw Add 16-bit signed integers horizontally, pack saturated integers to XMM1. +VEX.NDS.128.66.0F38.WIG 03 /r VPHADDSW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vphaddsw Add 16-bit signed integers horizontally, pack saturated integers to xmm1. +VEX.NDS.256.66.0F38.WIG 03 /r VPHADDSW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vphaddsw Add 16-bit signed integers horizontally, pack saturated integers to ymm1. + +66 0F 38 41 /r PHMINPOSUW xmm1, xmm2/m128 RM W, R V V SSE4_1 phminposuw Find the minimum unsigned word in xmm2/m128 and place its value in the low word of xmm1 and its index in the second-lowest word of xmm1. +VEX.128.66.0F38.WIG 41 /r VPHMINPOSUW xmm1, xmm2/m128 RM Z, R V V AVX vphminposuw Find the minimum unsigned word in xmm2/m128 and place its value in the low word of xmm1 and its index in the second-lowest word of xmm1. + +0F 38 05 /r PHSUBW mm1, mm2/m64 RM RW, R V V SSSE3 phsubw Subtract 16-bit signed integers horizontally, pack to MM1. +66 0F 38 05 /r PHSUBW xmm1, xmm2/m128 RM RW, R V V SSSE3 phsubw Subtract 16-bit signed integers horizontally, pack to XMM1. +0F 38 06 /r PHSUBD mm1, mm2/m64 RM RW, R V V SSSE3 phsubd Subtract 32-bit signed integers horizontally, pack to MM1. +66 0F 38 06 /r PHSUBD xmm1, xmm2/m128 RM RW, R V V SSSE3 phsubd Subtract 32-bit signed integers horizontally, pack to XMM1 +VEX.NDS.128.66.0F38.WIG 05 /r VPHSUBW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vphsubw Subtract 16-bit signed integers horizontally, pack to xmm1. +VEX.NDS.128.66.0F38.WIG 06 /r VPHSUBD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vphsubd Subtract 32-bit signed integers horizontally, pack to xmm1. +VEX.NDS.256.66.0F38.WIG 05 /r VPHSUBW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vphsubw Subtract 16-bit signed integers horizontally, pack to ymm1. +VEX.NDS.256.66.0F38.WIG 06 /r VPHSUBD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vphsubd Subtract 32-bit signed integers horizontally, pack to ymm1. + +0F 38 07 /r PHSUBSW mm1, mm2/m64 RM RW, R V V SSSE3 phsubsw Subtract 16-bit signed integer horizontally, pack saturated integers to MM1. +66 0F 38 07 /r PHSUBSW xmm1, xmm2/m128 RM RW, R V V SSSE3 phsubsw Subtract 16-bit signed integer horizontally, pack saturated integers to XMM1 +VEX.NDS.128.66.0F38.WIG 07 /r VPHSUBSW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vphsubsw Subtract 16-bit signed integer horizontally, pack saturated integers to xmm1. +VEX.NDS.256.66.0F38.WIG 07 /r VPHSUBSW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vphsubsw Subtract 16-bit signed integer horizontally, pack saturated integers to ymm1. + +66 0F 3A 20 /r ib PINSRB xmm1, r32/m8, imm8 RMI RW, R, R V V SSE4_1 pinsrb Insert a byte integer value from r32/m8 into xmm1 at the destination element in xmm1 specified by imm8. +66 0F 3A 22 /r ib PINSRD xmm1, r/m32, imm8 RMI RW, R, R V V SSE4_1 pinsrd Insert a dword integer value from r/m32 into the xmm1 at the destination element specified by imm8. +66 REX.W+ 0F 3A 22 /r ib PINSRQ xmm1, r/m64, imm8 NE V SSE4_1 pinsrq Insert a qword integer value from r/m64 into the xmm1 at the destination element specified by imm8. +VEX.NDS.128.66.0F3A.W0 20 /r ib VPINSRB xmm1, xmm2, r32/m8, imm8 RVMI Z, R, R, R V V AVX vpinsrb Merge a byte integer value from r32/m8 and rest from xmm2 into xmm1 at the byte offset in imm8. +VEX.NDS.128.66.0F3A.W0 22 /r ib VPINSRD xmm1, xmm2, r32/m32, imm8 RVMI Z, R, R, R V V AVX vpinsrd Insert a dword integer value from r32/m32 and rest from xmm2 into xmm1 at the dword offset in imm8. +VEX.NDS.128.66.0F3A.W1 22 /r ib VPINSRQ xmm1, xmm2, r64/m64, imm8 RVMI Z, R, R, R V I AVX vpinsrq Insert a qword integer value from r64/m64 and rest from xmm2 into xmm1 at the qword offset in imm8. + +0F C4 /r ib PINSRW mm, r32/m16, imm8 RMI RW, R, R V V SSE pinsrw Insert the low word from r32 or from m16 into mm at the word position specified by imm8 +66 0F C4 /r ib PINSRW xmm, r32/m16, imm8 RMI RW, R, R V V SSE2 pinsrw Move the low word of r32 or from m16 into xmm at the word position specified by imm8. +VEX.NDS.128.66.0F.W0 C4 /r ib VPINSRW xmm1, xmm2, r32/m16, imm8 RVMI Z, R, R, R V V AVX vpinsrw Insert a word integer value from r32/m16 and rest from xmm2 into xmm1 at the word offset in imm8. + +0F 38 04 /r PMADDUBSW mm1, mm2/m64 RM RW, R V V MMX SSSE3 pmaddubsw Multiply signed and unsigned bytes, add horizontal pair of signed words, pack saturated signed-words to MM1. +66 0F 38 04 /r PMADDUBSW xmm1, xmm2/m128 RM RW, R V V SSSE3 pmaddubsw Multiply signed and unsigned bytes, add horizontal pair of signed words, pack saturated signed-words to XMM1. +VEX.NDS.128.66.0F38.WIG 04 /r VPMADDUBSW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmaddubsw Multiply signed and unsigned bytes, add horizontal pair of signed words, pack saturated signed-words to xmm1. +VEX.NDS.256.66.0F38.WIG 04 /r VPMADDUBSW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmaddubsw Multiply signed and unsigned bytes, add horizontal pair of signed words, pack saturated signed-words to ymm1. + +0F F5 /r PMADDWD mm, mm/m64 RM RW, R V V MMX pmaddwd Multiply the packed words in mm by the packed words in mm/m64, add adjacent doubleword results, and store in mm. +66 0F F5 /r PMADDWD xmm1, xmm2/m128 RM RW, R V V SSE2 pmaddwd Multiply the packed word integers in xmm1 by the packed word integers in xmm2/m128, add adjacent doubleword results, and store in xmm1. +VEX.NDS.128.66.0F.WIG F5 /r VPMADDWD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmaddwd Multiply the packed word integers in xmm2 by the packed word integers in xmm3/m128, add adjacent doubleword results, and store in xmm1. +VEX.NDS.256.66.0F.WIG F5 /r VPMADDWD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmaddwd Multiply the packed word integers in ymm2 by the packed word integers in ymm3/m256, add adjacent doubleword results, and store in ymm1. + +66 0F 38 3C /r PMAXSB xmm1, xmm2/m128 RM RW, R V V SSE4_1 pmaxsb Compare packed signed byte integers in xmm1 and xmm2/m128 and store packed maximum values in xmm1. +VEX.NDS.128.66.0F38.WIG 3C /r VPMAXSB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmaxsb Compare packed signed byte integers in xmm2 and xmm3/m128 and store packed maximum values in xmm1. +VEX.NDS.256.66.0F38.WIG 3C /r VPMAXSB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmaxsb Compare packed signed byte integers in ymm2 and ymm3/m128 and store packed maximum values in ymm1. + +66 0F 38 3D /r PMAXSD xmm1, xmm2/m128 RM RW, R V V SSE4_1 pmaxsd Compare packed signed dword integers in xmm1 and xmm2/m128 and store packed maximum values in xmm1. +VEX.NDS.128.66.0F38.WIG 3D /r VPMAXSD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmaxsd Compare packed signed dword integers in xmm2 and xmm3/m128 and store packed maximum values in xmm1. +VEX.NDS.256.66.0F38.WIG 3D /r VPMAXSD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmaxsd Compare packed signed dword integers in ymm2 and ymm3/m128 and store packed maximum values in ymm1. + +0F EE /r PMAXSW mm1, mm2/m64 RM RW, R V V SSE pmaxsw Compare signed word integers in mm2/m64 and mm1 and return maximum values. +66 0F EE /r PMAXSW xmm1, xmm2/m128 RM RW, R V V SSE2 pmaxsw Compare signed word integers in xmm2/m128 and xmm1 and return maximum values. +VEX.NDS.128.66.0F.WIG EE /r VPMAXSW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmaxsw Compare packed signed word integers in xmm3/m128 and xmm2 and store packed maximum values in xmm1. +VEX.NDS.256.66.0F.WIG EE /r VPMAXSW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmaxsw Compare packed signed word integers in ymm3/m128 and ymm2 and store packed maximum values in ymm1. + +0F DE /r PMAXUB mm1, mm2/m64 RM RW, R V V SSE pmaxub Compare unsigned byte integers in mm2/m64 and mm1 and returns maximum values. +66 0F DE /r PMAXUB xmm1, xmm2/m128 RM RW, R V V SSE2 pmaxub Compare unsigned byte integers in xmm2/m128 and xmm1 and returns maximum values. +VEX.NDS.128.66.0F.WIG DE /r VPMAXUB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmaxub Compare packed unsigned byte integers in xmm2 and xmm3/m128 and store packed maximum values in xmm1. +VEX.NDS.256.66.0F.WIG DE /r VPMAXUB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmaxub Compare packed unsigned byte integers in ymm2 and ymm3/m256 and store packed maximum values in ymm1. + +66 0F 38 3F /r PMAXUD xmm1, xmm2/m128 RM RW, R V V SSE4_1 pmaxud Compare packed unsigned dword integers in xmm1 and xmm2/m128 and store packed maximum values in xmm1. +VEX.NDS.128.66.0F38.WIG 3F /r VPMAXUD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmaxud Compare packed unsigned dword integers in xmm2 and xmm3/m128 and store packed maximum values in xmm1. +VEX.NDS.256.66.0F38.WIG 3F /r VPMAXUD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmaxud Compare packed unsigned dword integers in ymm2 and ymm3/m256 and store packed maximum values in ymm1. + +66 0F 38 3E /r PMAXUW xmm1, xmm2/m128 RM RW, R V V SSE4_1 pmaxuw Compare packed unsigned word integers in xmm1 and xmm2/m128 and store packed maximum values in xmm1. +VEX.NDS.128.66.0F38.WIG 3E /r VPMAXUW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmaxuw Compare packed unsigned word integers in xmm3/m128 and xmm2 and store maximum packed values in xmm1. +VEX.NDS.256.66.0F38.WIG 3E /r VPMAXUW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmaxuw Compare packed unsigned word integers in ymm3/m256 and ymm2 and store maximum packed values in ymm1. + +66 0F 38 38 /r PMINSB xmm1, xmm2/m128 RM RW, R V V SSE4_1 pminsb Compare packed signed byte integers in xmm1 and xmm2/m128 and store packed minimum values in xmm1. +VEX.NDS.128.66.0F38.WIG 38 /r VPMINSB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpminsb Compare packed signed byte integers in xmm2 and xmm3/m128 and store packed minimum values in xmm1. +VEX.NDS.256.66.0F38.WIG 38 /r VPMINSB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpminsb Compare packed signed byte integers in ymm2 and ymm3/m256 and store packed minimum values in ymm1. + +66 0F 38 39 /r PMINSD xmm1, xmm2/m128 RM RW, R V V SSE4_1 pminsd Compare packed signed dword integers in xmm1 and xmm2/m128 and store packed minimum values in xmm1. +VEX.NDS.128.66.0F38.WIG 39 /r VPMINSD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpminsd Compare packed signed dword integers in xmm2 and xmm3/m128 and store packed minimum values in xmm1. +VEX.NDS.256.66.0F38.WIG 39 /r VPMINSD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpminsd Compare packed signed dword integers in ymm2 and ymm3/m128 and store packed minimum values in ymm1. + +0F EA /r PMINSW mm1, mm2/m64 RM RW, R V V SSE pminsw Compare signed word integers in mm2/m64 and mm1 and return minimum values. +66 0F EA /r PMINSW xmm1, xmm2/m128 RM RW, R V V SSE2 pminsw Compare signed word integers in xmm2/m128 and xmm1 and return minimum values. +VEX.NDS.128.66.0F.WIG EA /r VPMINSW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpminsw Compare packed signed word integers in xmm3/m128 and xmm2 and return packed minimum values in xmm1. + +0F DA /r PMINUB mm1, mm2/m64 RM RW, R V V SSE pminub Compare unsigned byte integers in mm2/m64 and mm1 and returns minimum values. +66 0F DA /r PMINUB xmm1, xmm2/m128 RM RW, R V V SSE2 pminub Compare unsigned byte integers in xmm2/m128 and xmm1 and returns minimum values. +VEX.NDS.128.66.0F.WIG DA /r VPMINUB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpminub Compare packed unsigned byte integers in xmm2 and xmm3/m128 and store packed minimum values in xmm1. +VEX.NDS.256.66.0F.WIG DA /r VPMINUB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpminub Compare packed unsigned byte integers in ymm2 and ymm3/m256 and store packed minimum values in ymm1. + +66 0F 38 3B /r PMINUD xmm1, xmm2/m128 RM RW, R V V SSE4_1 pminud Compare packed unsigned dword integers in xmm1 and xmm2/m128 and store packed minimum values in xmm1. +VEX.NDS.128.66.0F38.WIG 3B /r VPMINUD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpminud Compare packed unsigned dword integers in xmm2 and xmm3/m128 and store packed minimum values in xmm1. +VEX.NDS.256.66.0F38.WIG 3B /r VPMINUD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpminud Compare packed unsigned dword integers in ymm2 and ymm3/m256 and store packed minimum values in ymm1. + +66 0F 38 3A /r PMINUW xmm1, xmm2/m128 RM RW, R V V SSE4_1 pminuw Compare packed unsigned word integers in xmm1 and xmm2/m128 and store packed minimum values in xmm1. +VEX.NDS.128.66.0F38.WIG 3A /r VPMINUW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpminuw Compare packed unsigned word integers in xmm3/m128 and xmm2 and return packed minimum values in xmm1. +VEX.NDS.256.66.0F38.WIG 3A /r VPMINUW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpminuw Compare packed unsigned word integers in ymm3/m256 and ymm2 and return packed minimum values in ymm1. + +0F D7 /r PMOVMSKB reg, mm RM W, R V V SSE pmovmskb Move a byte mask of mm to reg. The upper bits of r32 or r64 are zeroed +66 0F D7 /r PMOVMSKB reg, xmm RM W, R V V SSE2 pmovmskb Move a byte mask of xmm to reg. The upper bits of r32 or r64 are zeroed +VEX.128.66.0F.WIG D7 /r VPMOVMSKB reg, xmm1 RM W, R V V AVX vpmovmskb Move a byte mask of xmm1 to reg. The upper bits of r32 or r64 are filled with zeros. +VEX.256.66.0F.WIG D7 /r VPMOVMSKB reg, ymm1 RM W, R V V AVX2 vpmovmskb Move a 32-bit mask of ymm1 to reg. The upper bits of r64 are filled with zeros. + +66 0f 38 20 /r PMOVSXBW xmm1, xmm2/m64 RM W, R V V SSE4_1 pmovsxbw Sign extend 8 packed signed 8-bit integers in the low 8 bytes of xmm2/m64 to 8 packed signed 16-bit integers in xmm1. +66 0f 38 21 /r PMOVSXBD xmm1, xmm2/m32 RM W, R V V SSE4_1 pmovsxbd Sign extend 4 packed signed 8-bit integers in the low 4 bytes of xmm2/m32 to 4 packed signed 32-bit integers in xmm1. +66 0f 38 22 /r PMOVSXBQ xmm1, xmm2/m16 RM W, R V V SSE4_1 pmovsxbq Sign extend 2 packed signed 8-bit integers in the low 2 bytes of xmm2/m16 to 2 packed signed 64-bit integers in xmm1. +66 0f 38 23 /r PMOVSXWD xmm1, xmm2/m64 RM W, R V V SSE4_1 pmovsxwd Sign extend 4 packed signed 16-bit integers in the low 8 bytes of xmm2/m64 to 4 packed signed 32-bit integers in xmm1. +66 0f 38 24 /r PMOVSXWQ xmm1, xmm2/m32 RM W, R V V SSE4_1 pmovsxwq Sign extend 2 packed signed 16-bit integers in the low 4 bytes of xmm2/m32 to 2 packed signed 64-bit integers in xmm1. +66 0f 38 25 /r PMOVSXDQ xmm1, xmm2/m64 RM W, R V V SSE4_1 pmovsxdq Sign extend 2 packed signed 32-bit integers in the low 8 bytes of xmm2/m64 to 2 packed signed 64-bit integers in xmm1. +VEX.128.66.0F38.WIG 20 /r VPMOVSXBW xmm1, xmm2/m64 RM Z, R V V AVX vpmovsxbw Sign extend 8 packed 8-bit integers in the low 8 bytes of xmm2/m64 to 8 packed 16-bit integers in xmm1. +VEX.128.66.0F38.WIG 21 /r VPMOVSXBD xmm1, xmm2/m32 RM Z, R V V AVX vpmovsxbd Sign extend 4 packed 8-bit integers in the low 4 bytes of xmm2/m32 to 4 packed 32-bit integers in xmm1. +VEX.128.66.0F38.WIG 22 /r VPMOVSXBQ xmm1, xmm2/m16 RM Z, R V V AVX vpmovsxbq Sign extend 2 packed 8-bit integers in the low 2 bytes of xmm2/m16 to 2 packed 64-bit integers in xmm1. +VEX.128.66.0F38.WIG 23 /r VPMOVSXWD xmm1, xmm2/m64 RM Z, R V V AVX vpmovsxwd Sign extend 4 packed 16-bit integers in the low 8 bytes of xmm2/m64 to 4 packed 32-bit integers in xmm1. +VEX.128.66.0F38.WIG 24 /r VPMOVSXWQ xmm1, xmm2/m32 RM Z, R V V AVX vpmovsxwq Sign extend 2 packed 16-bit integers in the low 4 bytes of xmm2/m32 to 2 packed 64-bit integers in xmm1. +VEX.128.66.0F38.WIG 25 /r VPMOVSXDQ xmm1, xmm2/m64 RM Z, R V V AVX vpmovsxdq Sign extend 2 packed 32-bit integers in the low 8 bytes of xmm2/m64 to 2 packed 64-bit integers in xmm1 +VEX.256.66.0F38.WIG 20 /r VPMOVSXBW ymm1, xmm2/m128 RM W, R V V AVX2 vpmovsxbw Sign extend 16 packed 8-bit integers in xmm2/m128 to 16 packed 16-bit integers in ymm1. +VEX.256.66.0F38.WIG 21 /r VPMOVSXBD ymm1, xmm2/m64 RM W, R V V AVX2 vpmovsxbd Sign extend 8 packed 8-bit integers in the low 8 bytes of xmm2/m64 to 8 packed 32-bit integers in ymm1. +VEX.256.66.0F38.WIG 22 /r VPMOVSXBQ ymm1, xmm2/m32 RM W, R V V AVX2 vpmovsxbq Sign extend 4 packed 8-bit integers in the low 4 bytes of xmm2/m32 to 4 packed 64-bit integers in ymm1. +VEX.256.66.0F38.WIG 23 /r VPMOVSXWD ymm1, xmm2/m128 RM W, R V V AVX2 vpmovsxwd Sign extend 8 packed 16-bit integers in the low 16 bytes of xmm2/m128 to 8 packed 32-bit integers in ymm1. +VEX.256.66.0F38.WIG 24 /r VPMOVSXWQ ymm1, xmm2/m64 RM W, R V V AVX2 vpmovsxwq Sign extend 4 packed 16-bit integers in the low 8 bytes of xmm2/m64 to 4 packed 64-bit integers in ymm1. +VEX.256.66.0F38.WIG 25 /r VPMOVSXDQ ymm1, xmm2/m128 RM W, R V V AVX2 vpmovsxdq Sign extend 4 packed 32-bit integers in the low 16 bytes of xmm2/m128 to 4 packed 64-bit integers in ymm1. + +66 0f 38 30 /r PMOVZXBW xmm1, xmm2/m64 RM W, R V V SSE4_1 pmovzxbw Zero extend 8 packed 8-bit integers in the low 8 bytes of xmm2/m64 to 8 packed 16-bit integers in xmm1. +66 0f 38 31 /r PMOVZXBD xmm1, xmm2/m32 RM W, R V V SSE4_1 pmovzxbd Zero extend 4 packed 8-bit integers in the low 4 bytes of xmm2/m32 to 4 packed 32-bit integers in xmm1. +66 0f 38 32 /r PMOVZXBQ xmm1, xmm2/m16 RM W, R V V SSE4_1 pmovzxbq Zero extend 2 packed 8-bit integers in the low 2 bytes of xmm2/m16 to 2 packed 64-bit integers in xmm1. +66 0f 38 33 /r PMOVZXWD xmm1, xmm2/m64 RM W, R V V SSE4_1 pmovzxwd Zero extend 4 packed 16-bit integers in the low 8 bytes of xmm2/m64 to 4 packed 32-bit integers in xmm1. +66 0f 38 34 /r PMOVZXWQ xmm1, xmm2/m32 RM W, R V V SSE4_1 pmovzxwq Zero extend 2 packed 16-bit integers in the low 4 bytes of xmm2/m32 to 2 packed 64-bit integers in xmm1. +66 0f 38 35 /r PMOVZXDQ xmm1, xmm2/m64 RM W, R V V SSE4_1 pmovzxdq Zero extend 2 packed 32-bit integers in the low 8 bytes of xmm2/m64 to 2 packed 64-bit integers in xmm1. +VEX.128.66.0F38.WIG 30 /r VPMOVZXBW xmm1, xmm2/m64 RM Z, R V V AVX vpmovzxbw Zero extend 8 packed 8-bit integers in the low 8 bytes of xmm2/m64 to 8 packed 16-bit integers in xmm1. +VEX.128.66.0F38.WIG 31 /r VPMOVZXBD xmm1, xmm2/m32 RM Z, R V V AVX vpmovzxbd Zero extend 4 packed 8-bit integers in the low 4 bytes of xmm2/m32 to 4 packed 32-bit integers in xmm1. +VEX.128.66.0F38.WIG 32 /r VPMOVZXBQ xmm1, xmm2/m16 RM Z, R V V AVX vpmovzxbq Zero extend 2 packed 8-bit integers in the low 2 bytes of xmm2/m16 to 2 packed 64-bit integers in xmm1. +VEX.128.66.0F38.WIG 33 /r VPMOVZXWD xmm1, xmm2/m64 RM Z, R V V AVX vpmovzxwd Zero extend 4 packed 16-bit integers in the low 8 bytes of xmm2/m64 to 4 packed 32-bit integers in xmm1. +VEX.128.66.0F38.WIG 34 /r VPMOVZXWQ xmm1, xmm2/m32 RM Z, R V V AVX vpmovzxwq Zero extend 2 packed 16-bit integers in the low 4 bytes of xmm2/m32 to 2 packed 64-bit integers in xmm1. +VEX.128.66.0F38.WIG 35 /r VPMOVZXDQ xmm1, xmm2/m64 RM Z, R V V AVX vpmovzxdq Zero extend 2 packed 32-bit integers in the low 8 bytes of xmm2/m64 to 2 packed 64-bit integers in xmm1. +VEX.256.66.0F38.WIG 30 /r VPMOVZXBW ymm1, xmm2/m128 RM W, R V V AVX2 vpmovzxbw Zero extend 16 packed 8-bit integers in the low 16 bytes of xmm2/m128 to 16 packed 16-bit integers in ymm1. +VEX.256.66.0F38.WIG 31 /r VPMOVZXBD ymm1, xmm2/m64 RM W, R V V AVX2 vpmovzxbd Zero extend 8 packed 8-bit integers in the low 8 bytes of xmm2/m64 to 8 packed 32-bit integers in ymm1. +VEX.256.66.0F38.WIG 32 /r VPMOVZXBQ ymm1, xmm2/m32 RM W, R V V AVX2 vpmovzxbq Zero extend 4 packed 8-bit integers in the low 4 bytes of xmm2/m32 to 4 packed 64-bit integers in ymm1. +VEX.256.66.0F38.WIG 33 /r VPMOVZXWD ymm1, xmm2/m128 RM W, R V V AVX2 vpmovzxwd Zero extend 8 packed 16-bit integers in the low 16 bytes of xmm2/m128 to 8 packed 32-bit integers in ymm1 +VEX.256.66.0F38.WIG 34 /r VPMOVZXWQ ymm1, xmm2/m64 RM W, R V V AVX2 vpmovzxwq Zero extend 4 packed 16-bit integers in the low 8 bytes of xmm2/m64 to 4 packed 64-bit integers in xmm1. +VEX.256.66.0F38.WIG 35 /r VPMOVZXDQ ymm1, xmm2/m128 RM W, R V V AVX2 vpmovzxdq Zero extend 4 packed 32-bit integers in the low 16 bytes of xmm2/m128 to 4 packed 64-bit integers in ymm1. + +66 0F 38 28 /r PMULDQ xmm1, xmm2/m128 RM RW, R V V SSE4_1 pmuldq Multiply the packed signed dword integers in xmm1 and xmm2/m128 and store the quadword product in xmm1. +VEX.NDS.128.66.0F38.WIG 28 /r VPMULDQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmuldq Multiply packed signed doubleword integers in xmm2 by packed signed doubleword integers in xmm3/m128, and store the quadword results in xmm1. +VEX.NDS.256.66.0F38.WIG 28 /r VPMULDQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmuldq Multiply packed signed doubleword integers in ymm2 by packed signed doubleword integers in ymm3/m256, and store the quadword results in ymm1. + +0F 38 0B /r PMULHRSW mm1, mm2/m64 RM RW, R V V SSSE3 pmulhrsw Multiply 16-bit signed words, scale and round signed doublewords, pack high 16 bits to MM1. +66 0F 38 0B /r PMULHRSW xmm1, xmm2/m128 RM RW, R V V SSSE3 pmulhrsw Multiply 16-bit signed words, scale and round signed doublewords, pack high 16 bits to XMM1. +VEX.NDS.128.66.0F38.WIG 0B /r VPMULHRSW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmulhrsw Multiply 16-bit signed words, scale and round signed doublewords, pack high 16 bits to xmm1. +VEX.NDS.256.66.0F38.WIG 0B /r VPMULHRSW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmulhrsw Multiply 16-bit signed words, scale and round signed doublewords, pack high 16 bits to ymm1. + +0F E4 /r PMULHUW mm1, mm2/m64 RM RW, R V V SSE pmulhuw Multiply the packed unsigned word integers in mm1 register and mm2/m64, and store the high 16 bits of the results in mm1. +66 0F E4 /r PMULHUW xmm1, xmm2/m128 RM RW, R V V SSE2 pmulhuw Multiply the packed unsigned word integers in xmm1 and xmm2/m128, and store the high 16 bits of the results in xmm1. +VEX.NDS.128.66.0F.WIG E4 /r VPMULHUW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmulhuw Multiply the packed unsigned word integers in xmm2 and xmm3/m128, and store the high 16 bits of the results in xmm1. +VEX.NDS.256.66.0F.WIG E4 /r VPMULHUW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmulhuw Multiply the packed unsigned word integers in ymm2 and ymm3/m256, and store the high 16 bits of the results in ymm1. + +0F E5 /r PMULHW mm, mm/m64 RM RW, R V V MMX pmulhw Multiply the packed signed word integers in mm1 register and mm2/m64, and store the high 16 bits of the results in mm1. +66 0F E5 /r PMULHW xmm1, xmm2/m128 RM RW, R V V SSE2 pmulhw Multiply the packed signed word integers in xmm1 and xmm2/m128, and store the high 16 bits of the results in xmm1. +VEX.NDS.128.66.0F.WIG E5 /r VPMULHW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmulhw Multiply the packed signed word integers in xmm2 and xmm3/m128, and store the high 16 bits of the results in xmm1. +VEX.NDS.256.66.0F.WIG E5 /r VPMULHW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmulhw Multiply the packed signed word integers in ymm2 and ymm3/m256, and store the high 16 bits of the results in ymm1. + +66 0F 38 40 /r PMULLD xmm1, xmm2/m128 RM RW, R V V SSE4_1 pmulld Multiply the packed dword signed integers in xmm1 and xmm2/m128 and store the low 32 bits of each product in xmm1. +VEX.NDS.128.66.0F38.WIG 40 /r VPMULLD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmulld Multiply the packed dword signed integers in xmm2 and xmm3/m128 and store the low 32 bits of each product in xmm1. +VEX.NDS.256.66.0F38.WIG 40 /r VPMULLD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmulld Multiply the packed dword signed integers in ymm2 and ymm3/m256 and store the low 32 bits of each product in ymm1. + +0F D5 /r PMULLW mm, mm/m64 RM RW, R V V MMX pmullw Multiply the packed signed word integers in mm1 register and mm2/m64, and store the low 16 bits of the results in mm1. +66 0F D5 /r PMULLW xmm1, xmm2/m128 RM RW, R V V SSE2 pmullw Multiply the packed signed word integers in xmm1 and xmm2/m128, and store the low 16 bits of the results in xmm1. +VEX.NDS.128.66.0F.WIG D5 /r VPMULLW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmullw Multiply the packed dword signed integers in xmm2 and xmm3/m128 and store the low 32 bits of each product in xmm1. +VEX.NDS.256.66.0F.WIG D5 /r VPMULLW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmullw Multiply the packed signed word integers in ymm2 and ymm3/m256, and store the low 16 bits of the results in ymm1. + +0F F4 /r PMULUDQ mm1, mm2/m64 RM RW, R V V SSE2 pmuludq Multiply unsigned doubleword integer in mm1 by unsigned doubleword integer in mm2/m64, and store the quadword result in mm1. +66 0F F4 /r PMULUDQ xmm1, xmm2/m128 RM RW, R V V SSE2 pmuludq Multiply packed unsigned doubleword integers in xmm1 by packed unsigned doubleword integers in xmm2/m128, and store the quadword results in xmm1. +VEX.NDS.128.66.0F.WIG F4 /r VPMULUDQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpmuludq Multiply packed unsigned doubleword integers in xmm2 by packed unsigned doubleword integers in xmm3/m128, and store the quadword results in xmm1. +VEX.NDS.256.66.0F.WIG F4 /r VPMULUDQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpmuludq Multiply packed unsigned doubleword integers in ymm2 by packed unsigned doubleword integers in ymm3/m256, and store the quadword results in ymm1. + +8F /0 POP r/m16 M W RSP RSP V V popw Pop top of stack into m16; increment stack pointer. +8F /0 POP r/m32 RSP RSP NE V Pop top of stack into m32; increment stack pointer. +8F /0 POP r/m64 M W RSP RSP V NE popq Pop top of stack into m64; increment stack pointer. Cannot encode 32-bit operand size. +58 +rw POP r16 O W RSP RSP V V popw YES Pop top of stack into r16; increment stack pointer. +58 +rd POP r32 RSP RSP NE V Pop top of stack into r32; increment stack pointer. +58 +rd POP r64 O W RSP RSP V NE popq YES Pop top of stack into r64; increment stack pointer. Cannot encode 32-bit operand size. +1F POP DS RSP RSP I V Pop top of stack into DS; increment stack pointer. +07 POP ES RSP RSP I V Pop top of stack into ES; increment stack pointer. +17 POP SS RSP RSP I V Pop top of stack into SS; increment stack pointer. +PREF.66+ 0F A1 POP FS, p66 NP W, I RSP RSP V V popq Pop top of stack into FS; increment stack pointer by 16 bits. +0F A1 POP FS RSP RSP NE V Pop top of stack into FS; increment stack pointer by 32 bits. +0F A1 POP FS NP W RSP RSP V NE popq Pop top of stack into FS; increment stack pointer by 64 bits. +PREF.66+ 0F A9 POP GS, p66 NP W, I RSP RSP V V popq Pop top of stack into GS; increment stack pointer by 16 bits. +0F A9 POP GS RSP RSP NE V Pop top of stack into GS; increment stack pointer by 32 bits. +0F A9 POP GS NP W RSP RSP V NE popq Pop top of stack into GS; increment stack pointer by 64 bits. + +61 POPA RSP RSP I V Pop DI, SI, BP, BX, DX, CX, and AX. +61 POPAD RSP RSP I V Pop EDI, ESI, EBP, EBX, EDX, ECX, and EAX. + +F3 0F B8 /r POPCNT r16, r/m16 RM W, R E.OF E.SF E.ZF E.AF E.CF E.PF V V POPCNT popcntw POPCNT on r/m16 +F3 0F B8 /r POPCNT r32, r/m32 RM W, R E.OF E.SF E.ZF E.AF E.CF E.PF V V POPCNT popcntl POPCNT on r/m32 +F3 REX.W+ 0F B8 /r POPCNT r64, r/m64 RM W, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE POPCNT popcntq POPCNT on r/m64 + +66 9D POPF NP RSP E.* RSP V V popfw Pop top of stack into lower 16 bits of EFLAGS. +9D POPFD NE V Pop top of stack into EFLAGS. +9D POPFQ NP RSP E.* RSP V NE popfq Pop top of stack and zero-extend into RFLAGS. + +0F EB /r POR mm, mm/m64 RM RW, R V V MMX por Bitwise OR of mm/m64 and mm. +66 0F EB /r POR xmm1, xmm2/m128 RM RW, R V V SSE2 por Bitwise OR of xmm2/m128 and xmm1. +VEX.NDS.128.66.0F.WIG EB /r VPOR xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpor Bitwise OR of xmm2/m128 and xmm3. +VEX.NDS.256.66.0F.WIG EB /r VPOR ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpor Bitwise OR of ymm2/m256 and ymm3 + +0F 18 /1 PREFETCHT0 m8 M I V V prefetcht0 Move data from m8 closer to the processor using T0 hint. +0F 18 /2 PREFETCHT1 m8 M I V V prefetcht1 Move data from m8 closer to the processor using T1 hint. +0F 18 /3 PREFETCHT2 m8 M I V V prefetcht2 Move data from m8 closer to the processor using T2 hint. +0F 18 /0 PREFETCHNTA m8 M I V V prefetchnta Move data from m8 closer to the processor using NTA hint. + +0F F6 /r PSADBW mm1, mm2/m64 RM RW, R V V SSE psadbw Computes the absolute differences of the packed unsigned byte integers from mm2 /m64 and mm1; differences are then summed to produce an unsigned word integer result. +66 0F F6 /r PSADBW xmm1, xmm2/m128 RM RW, R V V SSE2 psadbw Computes the absolute differences of the packed unsigned byte integers from xmm2 /m128 and xmm1; the 8 low differences and 8 high differences are then summed separately to produce two unsigned word integer results. +VEX.NDS.128.66.0F.WIG F6 /r VPSADBW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsadbw Computes the absolute differences of the packed unsigned byte integers from xmm3 /m128 and xmm2; the 8 low differences and 8 high differences are then summed separately to produce two unsigned word integer results. +VEX.NDS.256.66.0F.WIG F6 /r VPSADBW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsadbw Computes the absolute differences of the packed unsigned byte integers from ymm3/m256 and ymm2; then each consecutive 8 differences are summed separately to produce four unsigned word integer results. + +0F 38 00 /r PSHUFB mm1, mm2/m64 RM RW, R V V SSSE3 pshufb Shuffle bytes in mm1 according to contents of mm2/m64. +66 0F 38 00 /r PSHUFB xmm1, xmm2/m128 RM RW, R V V SSSE3 pshufb Shuffle bytes in xmm1 according to contents of xmm2/m128. +VEX.NDS.128.66.0F38.WIG 00 /r VPSHUFB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpshufb Shuffle bytes in xmm2 according to contents of xmm3/m128. +VEX.NDS.256.66.0F38.WIG 00 /r VPSHUFB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpshufb Shuffle bytes in ymm2 according to contents of ymm3/m256. + +66 0F 70 /r ib PSHUFD xmm1, xmm2/m128, imm8 RMI W, R, R V V SSE2 pshufd Shuffle the doublewords in xmm2/m128 based on the encoding in imm8 and store the result in xmm1. +VEX.128.66.0F.WIG 70 /r ib VPSHUFD xmm1, xmm2/m128, imm8 RMI Z, R, R V V AVX vpshufd Shuffle the doublewords in xmm2/m128 based on the encoding in imm8 and store the result in xmm1. +VEX.256.66.0F.WIG 70 /r ib VPSHUFD ymm1, ymm2/m256, imm8 RMI W, R, R V V AVX2 vpshufd Shuffle the doublewords in ymm2/m256 based on the encoding in imm8 and store the result in ymm1. + +F3 0F 70 /r ib PSHUFHW xmm1, xmm2/m128, imm8 RMI W, R, R V V SSE2 pshufhw Shuffle the high words in xmm2/m128 based on the encoding in imm8 and store the result in xmm1. +VEX.128.F3.0F.WIG 70 /r ib VPSHUFHW xmm1, xmm2/m128, imm8 RMI Z, R, R V V AVX vpshufhw Shuffle the high words in xmm2/m128 based on the encoding in imm8 and store the result in xmm1. +VEX.256.F3.0F.WIG 70 /r ib VPSHUFHW ymm1, ymm2/m256, imm8 RMI W, R, R V V AVX2 vpshufhw Shuffle the high words in ymm2/m256 based on the encoding in imm8 and store the result in ymm1. + +F2 0F 70 /r ib PSHUFLW xmm1, xmm2/m128, imm8 RMI W, R, R V V SSE2 pshuflw Shuffle the low words in xmm2/m128 based on the encoding in imm8 and store the result in xmm1. +VEX.128.F2.0F.WIG 70 /r ib VPSHUFLW xmm1, xmm2/m128, imm8 RMI Z, R, R V V AVX vpshuflw Shuffle the low words in xmm2/m128 based on the encoding in imm8 and store the result in xmm1. +VEX.256.F2.0F.WIG 70 /r ib VPSHUFLW ymm1, ymm2/m256, imm8 RMI W, R, R V V AVX2 vpshuflw Shuffle the low words in ymm2/m256 based on the encoding in imm8 and store the result in ymm1. + +0F 70 /r ib PSHUFW mm1, mm2/m64, imm8 RMI W, R, R V V pshufw Shuffle the words in mm2/m64 based on the encoding in imm8 and store the result in mm1. + +0F 38 08 /r PSIGNB mm1, mm2/m64 RM RW, R V V SSSE3 psignb Negate/zero/preserve packed byte integers in mm1 depending on the corresponding sign in mm2/m64 +66 0F 38 08 /r PSIGNB xmm1, xmm2/m128 RM RW, R V V SSSE3 psignb Negate/zero/preserve packed byte integers in xmm1 depending on the corresponding sign in xmm2/m128. +0F 38 09 /r PSIGNW mm1, mm2/m64 RM RW, R V V SSSE3 psignw Negate/zero/preserve packed word integers in mm1 depending on the corresponding sign in mm2/m128. +66 0F 38 09 /r PSIGNW xmm1, xmm2/m128 RM RW, R V V SSSE3 psignw Negate/zero/preserve packed word integers in xmm1 depending on the corresponding sign in xmm2/m128. +0F 38 0A /r PSIGND mm1, mm2/m64 RM RW, R V V SSSE3 psignd Negate/zero/preserve packed doubleword integers in mm1 depending on the corresponding sign in mm2/m128. +66 0F 38 0A /r PSIGND xmm1, xmm2/m128 RM RW, R V V SSSE3 psignd Negate/zero/preserve packed doubleword integers in xmm1 depending on the corresponding sign in xmm2/m128. +VEX.NDS.128.66.0F38.WIG 08 /r VPSIGNB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsignb Negate/zero/preserve packed byte integers in xmm2 depending on the corresponding sign in xmm3/m128. +VEX.NDS.128.66.0F38.WIG 09 /r VPSIGNW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsignw Negate/zero/preserve packed word integers in xmm2 depending on the corresponding sign in xmm3/m128. +VEX.NDS.128.66.0F38.WIG 0A /r VPSIGND xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsignd Negate/zero/preserve packed doubleword integers in xmm2 depending on the corresponding sign in xmm3/m128. + +66 0F 73 /7 ib PSLLDQ xmm1, imm8 MI RW, R V V SSE2 pslldq Shift xmm1 left by imm8 bytes while shifting in 0s. +VEX.NDD.128.66.0F.WIG 73 /7 ib VPSLLDQ xmm1, xmm2, imm8 VMI Z, R, R V V AVX vpslldq Shift xmm2 left by imm8 bytes while shifting in 0s and store result in xmm1. +VEX.NDD.256.66.0F.WIG 73 /7 ib VPSLLDQ ymm1, ymm2, imm8 VMI W, R, R V V AVX2 vpslldq Shift ymm2 left by imm8 bytes while shifting in 0s and store result in ymm1. + +0F F1 /r PSLLW mm, mm/m64 RM RW, R V V MMX psllw Shift words in mm left mm/m64 while shifting in 0s. +66 0F F1 /r PSLLW xmm1, xmm2/m128 RM RW, R V V SSE2 psllw Shift words in xmm1 left by xmm2/m128 while shifting in 0s. +0F 71 /6 ib PSLLW mm1, imm8 MI RW, R V V MMX psllw Shift words in mm left by imm8 while shifting in 0s. +66 0F 71 /6 ib PSLLW xmm1, imm8 MI RW, R V V SSE2 psllw YES Shift words in xmm1 left by imm8 while shifting in 0s. +0F F2 /r PSLLD mm, mm/m64 RM RW, R V V MMX pslld Shift doublewords in mm left by mm/m64 while shifting in 0s. +66 0F F2 /r PSLLD xmm1, xmm2/m128 RM RW, R V V SSE2 pslld Shift doublewords in xmm1 left by xmm2/m128 while shifting in 0s. +0F 72 /6 ib PSLLD mm, imm8 MI RW, R V V MMX pslld Shift doublewords in mm left by imm8 while shifting in 0s. +66 0F 72 /6 ib PSLLD xmm1, imm8 MI RW, R V V SSE2 pslld Shift doublewords in xmm1 left by imm8 while shifting in 0s. +0F F3 /r PSLLQ mm, mm/m64 RM RW, R V V MMX psllq Shift quadword in mm left by mm/m64 while shifting in 0s. +66 0F F3 /r PSLLQ xmm1, xmm2/m128 RM RW, R V V SSE2 psllq Shift quadwords in xmm1 left by xmm2/m128 while shifting in 0s. +0F 73 /6 ib PSLLQ mm, imm8 MI RW, R V V MMX psllq Shift quadword in mm left by imm8 while shifting in 0s. +66 0F 73 /6 ib PSLLQ xmm1, imm8 MI RW, R V V SSE2 psllq Shift quadwords in xmm1 left by imm8 while shifting in 0s. +VEX.NDS.128.66.0F.WIG F1 /r VPSLLW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsllw Shift words in xmm2 left by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.128.66.0F.WIG 71 /6 ib VPSLLW xmm1, xmm2, imm8 VMI Z, R, R V V AVX vpsllw Shift words in xmm2 left by imm8 while shifting in 0s. +VEX.NDS.128.66.0F.WIG F2 /r VPSLLD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpslld Shift doublewords in xmm2 left by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.128.66.0F.WIG 72 /6 ib VPSLLD xmm1, xmm2, imm8 VMI Z, R, R V V AVX vpslld Shift doublewords in xmm2 left by imm8 while shifting in 0s. +VEX.NDS.128.66.0F.WIG F3 /r VPSLLQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsllq Shift quadwords in xmm2 left by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.128.66.0F.WIG 73 /6 ib VPSLLQ xmm1, xmm2, imm8 VMI Z, R, R V V AVX vpsllq Shift quadwords in xmm2 left by imm8 while shifting in 0s. +VEX.NDS.256.66.0F.WIG F1 /r VPSLLW ymm1, ymm2, xmm3/m128 RVM W, R, R V V AVX2 vpsllw Shift words in ymm2 left by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.256.66.0F.WIG 71 /6 ib VPSLLW ymm1, ymm2, imm8 VMI W, R, R V V AVX2 vpsllw Shift words in ymm2 left by imm8 while shifting in 0s. +VEX.NDS.256.66.0F.WIG F2 /r VPSLLD ymm1, ymm2, xmm3/m128 RVM W, R, R V V AVX2 vpslld Shift doublewords in ymm2 left by amount specified in xmm3/m128 while shifting in 0s +VEX.NDD.256.66.0F.WIG 72 /6 ib VPSLLD ymm1, ymm2, imm8 VMI W, R, R V V AVX2 vpslld Shift doublewords in ymm2 left by imm8 while shifting in 0s. +VEX.NDS.256.66.0F.WIG F3 /r VPSLLQ ymm1, ymm2, xmm3/m128 RVM W, R, R V V AVX2 vpsllq Shift quadwords in ymm2 left by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.256.66.0F.WIG 73 /6 ib VPSLLQ ymm1, ymm2, imm8 VMI W, R, R V V AVX2 vpsllq Shift quadwords in ymm2 left by imm8 while shifting in 0s. + +0F E1 /r PSRAW mm, mm/m64 RM RW, R V V MMX psraw Shift words in mm right by mm/m64 while shifting in sign bits. +66 0F E1 /r PSRAW xmm1, xmm2/m128 RM RW, R V V SSE2 psraw Shift words in xmm1 right by xmm2/m128 while shifting in sign bits. +0F 71 /4 ib PSRAW mm, imm8 MI RW, R V V MMX psraw Shift words in mm right by imm8 while shifting in sign bits +66 0F 71 /4 ib PSRAW xmm1, imm8 MI RW, R V V SSE2 psraw Shift words in xmm1 right by imm8 while shifting in sign bits +0F E2 /r PSRAD mm, mm/m64 RM RW, R V V MMX psrad Shift doublewords in mm right by mm/m64 while shifting in sign bits. +66 0F E2 /r PSRAD xmm1, xmm2/m128 RM RW, R V V SSE2 psrad Shift doubleword in xmm1 right by xmm2 /m128 while shifting in sign bits. +0F 72 /4 ib PSRAD mm, imm8 MI RW, R V V MMX psrad Shift doublewords in mm right by imm8 while shifting in sign bits. +66 0F 72 /4 ib PSRAD xmm1, imm8 MI RW, R V V SSE2 psrad Shift doublewords in xmm1 right by imm8 while shifting in sign bits. +VEX.NDS.128.66.0F.WIG E1 /r VPSRAW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsraw Shift words in xmm2 right by amount specified in xmm3/m128 while shifting in sign bits. +VEX.NDD.128.66.0F.WIG 71 /4 ib VPSRAW xmm1, xmm2, imm8 VMI Z, R, R V V AVX vpsraw Shift words in xmm2 right by imm8 while shifting in sign bits. +VEX.NDS.128.66.0F.WIG E2 /r VPSRAD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsrad Shift doublewords in xmm2 right by amount specified in xmm3/m128 while shifting in sign bits. +VEX.NDD.128.66.0F.WIG 72 /4 ib VPSRAD xmm1, xmm2, imm8 VMI Z, R, R V V AVX vpsrad Shift doublewords in xmm2 right by imm8 while shifting in sign bits. +VEX.NDS.256.66.0F.WIG E1 /r VPSRAW ymm1, ymm2, xmm3/m128 RVM W, R, R V V AVX2 vpsraw Shift words in ymm2 right by amount specified in xmm3/m128 while shifting in sign bits. +VEX.NDD.256.66.0F.WIG 71 /4 ib VPSRAW ymm1, ymm2, imm8 VMI W, R, R V V AVX2 vpsraw Shift words in ymm2 right by imm8 while shifting in sign bits. +VEX.NDS.256.66.0F.WIG E2 /r VPSRAD ymm1, ymm2, xmm3/m128 RVM W, R, R V V AVX2 vpsrad Shift doublewords in ymm2 right by amount specified in xmm3/m128 while shifting in sign bits. +VEX.NDD.256.66.0F.WIG 72 /4 ib VPSRAD ymm1, ymm2, imm8 VMI W, R, R V V AVX2 vpsrad Shift doublewords in ymm2 right by imm8 while shifting in sign bits. + +66 0F 73 /3 ib PSRLDQ xmm1, imm8 MI RW, R V V SSE2 psrldq Shift xmm1 right by imm8 while shifting in 0s. +VEX.NDD.128.66.0F.WIG 73 /3 ib VPSRLDQ xmm1, xmm2, imm8 VMI Z, R, R V V AVX vpsrldq Shift xmm2 right by imm8 bytes while shifting in 0s. +VEX.NDD.256.66.0F.WIG 73 /3 ib VPSRLDQ ymm1, ymm2, imm8 VMI W, R, R V V AVX2 vpsrldq Shift ymm1 right by imm8 bytes while shifting in 0s. + +0F D1 /r PSRLW mm, mm/m64 RM RW, R V V MMX psrlw Shift words in mm right by amount specified in mm/m64 while shifting in 0s. +66 0F D1 /r PSRLW xmm1, xmm2/m128 RM RW, R V V SSE2 psrlw Shift words in xmm1 right by amount specified in xmm2/m128 while shifting in 0s. +0F 71 /2 ib PSRLW mm, imm8 MI RW, R V V MMX psrlw Shift words in mm right by imm8 while shifting in 0s. +66 0F 71 /2 ib PSRLW xmm1, imm8 MI RW, R V V SSE2 psrlw Shift words in xmm1 right by imm8 while shifting in 0s. +0F D2 /r PSRLD mm, mm/m64 RM RW, R V V MMX psrld Shift doublewords in mm right by amount specified in mm/m64 while shifting in 0s. +66 0F D2 /r PSRLD xmm1, xmm2/m128 RM RW, R V V SSE2 psrld Shift doublewords in xmm1 right by amount specified in xmm2 /m128 while shifting in 0s. +0F 72 /2 ib PSRLD mm, imm8 MI RW, R V V MMX psrld Shift doublewords in mm right by imm8 while shifting in 0s. +66 0F 72 /2 ib PSRLD xmm1, imm8 MI RW, R V V SSE2 psrld Shift doublewords in xmm1 right by imm8 while shifting in 0s. +0F D3 /r PSRLQ mm, mm/m64 RM RW, R V V MMX psrlq Shift mm right by amount specified in mm/m64 while shifting in 0s. +66 0F D3 /r PSRLQ xmm1, xmm2/m128 RM RW, R V V SSE2 psrlq Shift quadwords in xmm1 right by amount specified in xmm2/m128 while shifting in 0s. +0F 73 /2 ib PSRLQ mm, imm8 MI RW, R V V MMX psrlq Shift mm right by imm8 while shifting in 0s. +66 0F 73 /2 ib PSRLQ xmm1, imm8 MI RW, R V V SSE2 psrlq Shift quadwords in xmm1 right by imm8 while shifting in 0s. +VEX.NDS.128.66.0F.WIG D1 /r VPSRLW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsrlw Shift words in xmm2 right by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.128.66.0F.WIG 71 /2 ib VPSRLW xmm1, xmm2, imm8 VMI Z, R, R V V AVX vpsrlw Shift words in xmm2 right by imm8 while shifting in 0s. +VEX.NDS.128.66.0F.WIG D2 /r VPSRLD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsrld Shift doublewords in xmm2 right by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.128.66.0F.WIG 72 /2 ib VPSRLD xmm1, xmm2, imm8 VMI Z, R, R V V AVX vpsrld Shift doublewords in xmm2 right by imm8 while shifting in 0s. +VEX.NDS.128.66.0F.WIG D3 /r VPSRLQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsrlq Shift quadwords in xmm2 right by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.128.66.0F.WIG 73 /2 ib VPSRLQ xmm1, xmm2, imm8 VMI Z, R, R V V AVX vpsrlq Shift quadwords in xmm2 right by imm8 while shifting in 0s. +VEX.NDS.256.66.0F.WIG D1 /r VPSRLW ymm1, ymm2, xmm3/m128 RVM W, R, R V V AVX2 vpsrlw Shift words in ymm2 right by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.256.66.0F.WIG 71 /2 ib VPSRLW ymm1, ymm2, imm8 VMI W, R, R V V AVX2 vpsrlw Shift words in ymm2 right by imm8 while shifting in 0s. +VEX.NDS.256.66.0F.WIG D2 /r VPSRLD ymm1, ymm2, xmm3/m128 RVM W, R, R V V AVX2 vpsrld Shift doublewords in ymm2 right by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.256.66.0F.WIG 72 /2 ib VPSRLD ymm1, ymm2, imm8 VMI W, R, R V V AVX2 vpsrld Shift doublewords in ymm2 right by imm8 while shifting in 0s. +VEX.NDS.256.66.0F.WIG D3 /r VPSRLQ ymm1, ymm2, xmm3/m128 RVM W, R, R V V AVX2 vpsrlq Shift quadwords in ymm2 right by amount specified in xmm3/m128 while shifting in 0s. +VEX.NDD.256.66.0F.WIG 73 /2 ib VPSRLQ ymm1, ymm2, imm8 VMI W, R, R V V AVX2 vpsrlq Shift quadwords in ymm2 right by imm8 while shifting in 0s. + +0F F8 /r PSUBB mm, mm/m64 RM RW, R V V MMX psubb Subtract packed byte integers in mm/m64 from packed byte integers in mm. +66 0F F8 /r PSUBB xmm1, xmm2/m128 RM RW, R V V SSE2 psubb Subtract packed byte integers in xmm2/m128 from packed byte integers in xmm1. +0F F9 /r PSUBW mm, mm/m64 RM RW, R V V MMX psubw Subtract packed word integers in mm/m64 from packed word integers in mm. +66 0F F9 /r PSUBW xmm1, xmm2/m128 RM RW, R V V SSE2 psubw Subtract packed word integers in xmm2/m128 from packed word integers in xmm1. +0F FA /r PSUBD mm, mm/m64 RM RW, R V V MMX psubd Subtract packed doubleword integers in mm/m64 from packed doubleword integers in mm. +66 0F FA /r PSUBD xmm1, xmm2/m128 RM RW, R V V SSE2 psubd Subtract packed doubleword integers in xmm2/mem128 from packed doubleword integers in xmm1. +VEX.NDS.128.66.0F.WIG F8 /r VPSUBB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsubb Subtract packed byte integers in xmm3/m128 from xmm2. +VEX.NDS.128.66.0F.WIG F9 /r VPSUBW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsubw Subtract packed word integers in xmm3/m128 from xmm2. +VEX.NDS.128.66.0F.WIG FA /r VPSUBD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsubd Subtract packed doubleword integers in xmm3/m128 from xmm2. +VEX.NDS.256.66.0F.WIG F8 /r VPSUBB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsubb Subtract packed byte integers in ymm3/m256 from ymm2. +VEX.NDS.256.66.0F.WIG F9 /r VPSUBW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsubw Subtract packed word integers in ymm3/m256 from ymm2. +VEX.NDS.256.66.0F.WIG FA /r VPSUBD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsubd Subtract packed doubleword integers in ymm3/m256 from ymm2. + +0F FB /r PSUBQ mm1, mm2/m64 RM RW, R V V SSE2 psubq Subtract quadword integer in mm1 from mm2 /m64. +66 0F FB /r PSUBQ xmm1, xmm2/m128 RM RW, R V V SSE2 psubq Subtract packed quadword integers in xmm1 from xmm2 /m128. +VEX.NDS.128.66.0F.WIG FB /r VPSUBQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsubq Subtract packed quadword integers in xmm3/m128 from xmm2. +VEX.NDS.256.66.0F.WIG FB /r VPSUBQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsubq Subtract packed quadword integers in ymm3/m256 from ymm2. + +0F E8 /r PSUBSB mm, mm/m64 RM RW, R V V MMX psubsb Subtract signed packed bytes in mm/m64 from signed packed bytes in mm and saturate results. +66 0F E8 /r PSUBSB xmm1, xmm2/m128 RM RW, R V V SSE2 psubsb Subtract packed signed byte integers in xmm2/m128 from packed signed byte integers in xmm1 and saturate results. +0F E9 /r PSUBSW mm, mm/m64 RM RW, R V V MMX psubsw Subtract signed packed words in mm/m64 from signed packed words in mm and saturate results. +66 0F E9 /r PSUBSW xmm1, xmm2/m128 RM RW, R V V SSE2 psubsw Subtract packed signed word integers in xmm2/m128 from packed signed word integers in xmm1 and saturate results. +VEX.NDS.128.66.0F.WIG E8 /r VPSUBSB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsubsb Subtract packed signed byte integers in xmm3/m128 from packed signed byte integers in xmm2 and saturate results. +VEX.NDS.128.66.0F.WIG E9 /r VPSUBSW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsubsw Subtract packed signed word integers in xmm3/m128 from packed signed word integers in xmm2 and saturate results. +VEX.NDS.256.66.0F.WIG E8 /r VPSUBSB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsubsb Subtract packed signed byte integers in ymm3/m256 from packed signed byte integers in ymm2 and saturate results. +VEX.NDS.256.66.0F.WIG E9 /r VPSUBSW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsubsw Subtract packed signed word integers in ymm3/m256 from packed signed word integers in ymm2 and saturate results. + +0F D8 /r PSUBUSB mm, mm/m64 RM RW, R V V MMX psubusb Subtract unsigned packed bytes in mm/m64 from unsigned packed bytes in mm and saturate result. +66 0F D8 /r PSUBUSB xmm1, xmm2/m128 RM RW, R V V SSE2 psubusb Subtract packed unsigned byte integers in xmm2/m128 from packed unsigned byte integers in xmm1 and saturate result. +0F D9 /r PSUBUSW mm, mm/m64 RM RW, R V V MMX psubusw Subtract unsigned packed words in mm/m64 from unsigned packed words in mm and saturate result. +66 0F D9 /r PSUBUSW xmm1, xmm2/m128 RM RW, R V V SSE2 psubusw Subtract packed unsigned word integers in xmm2/m128 from packed unsigned word integers in xmm1 and saturate result. +VEX.NDS.128.66.0F.WIG D8 /r VPSUBUSB xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsubusb Subtract packed unsigned byte integers in xmm3/m128 from packed unsigned byte integers in xmm2 and saturate result. +VEX.NDS.128.66.0F.WIG D9 /r VPSUBUSW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpsubusw Subtract packed unsigned word integers in xmm3/m128 from packed unsigned word integers in xmm2 and saturate result. +VEX.NDS.256.66.0F.WIG D8 /r VPSUBUSB ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsubusb Subtract packed unsigned byte integers in ymm3/m256 from packed unsigned byte integers in ymm2 and saturate result. +VEX.NDS.256.66.0F.WIG D9 /r VPSUBUSW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsubusw Subtract packed unsigned word integers in ymm3/m256 from packed unsigned word integers in ymm2 and saturate result. + +66 0F 38 17 /r PTEST xmm1, xmm2/m128 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V SSE4_1 ptest Set ZF if xmm2/m128 AND xmm1 result is all 0s. Set CF if xmm2/m128 AND NOT xmm1 result is all 0s. +VEX.128.66.0F38.WIG 17 /r VPTEST xmm1, xmm2/m128 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V AVX vptest Set ZF and CF depending on bitwise AND and ANDN of sources. +VEX.256.66.0F38.WIG 17 /r VPTEST ymm1, ymm2/m256 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V AVX vptest Set ZF and CF depending on bitwise AND and ANDN of sources. + +0F 68 /r PUNPCKHBW mm, mm/m64 RM RW, R V V MMX punpckhbw Unpack and interleave high-order bytes from mm and mm/m64 into mm. +66 0F 68 /r PUNPCKHBW xmm1, xmm2/m128 RM RW, R V V SSE2 punpckhbw Unpack and interleave high-order bytes from xmm1 and xmm2/m128 into xmm1. +0F 69 /r PUNPCKHWD mm, mm/m64 RM RW, R V V MMX punpckhwd Unpack and interleave high-order words from mm and mm/m64 into mm. +66 0F 69 /r PUNPCKHWD xmm1, xmm2/m128 RM RW, R V V SSE2 punpckhwd Unpack and interleave high-order words from xmm1 and xmm2/m128 into xmm1. +0F 6A /r PUNPCKHDQ mm, mm/m64 RM RW, R V V MMX punpckhdq Unpack and interleave high-order doublewords from mm and mm/m64 into mm. +66 0F 6A /r PUNPCKHDQ xmm1, xmm2/m128 RM RW, R V V SSE2 punpckhdq Unpack and interleave high-order doublewords from xmm1 and xmm2/m128 into xmm1. +66 0F 6D /r PUNPCKHQDQ xmm1, xmm2/m128 RM RW, R V V SSE2 punpckhqdq Unpack and interleave high-order quadwords from xmm1 and xmm2/m128 into xmm1. +VEX.NDS.128.66.0F.WIG 68 /r VPUNPCKHBW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpunpckhbw Interleave high-order bytes from xmm2 and xmm3/m128 into xmm1. +VEX.NDS.128.66.0F.WIG 69 /r VPUNPCKHWD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpunpckhwd Interleave high-order words from xmm2 and xmm3/m128 into xmm1. +VEX.NDS.128.66.0F.WIG 6A /r VPUNPCKHDQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpunpckhdq Interleave high-order doublewords from xmm2 and xmm3/m128 into xmm1. +VEX.NDS.128.66.0F.WIG 6D /r VPUNPCKHQDQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpunpckhqdq Interleave high-order quadword from xmm2 and xmm3/m128 into xmm1 register. +VEX.NDS.256.66.0F.WIG 68 /r VPUNPCKHBW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpunpckhbw Interleave high-order bytes from ymm2 and ymm3/m256 into ymm1 register. +VEX.NDS.256.66.0F.WIG 69 /r VPUNPCKHWD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpunpckhwd Interleave high-order words from ymm2 and ymm3/m256 into ymm1 register. +VEX.NDS.256.66.0F.WIG 6A /r VPUNPCKHDQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpunpckhdq Interleave high-order doublewords from ymm2 and ymm3/m256 into ymm1 register. +VEX.NDS.256.66.0F.WIG 6D /r VPUNPCKHQDQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpunpckhqdq Interleave high-order quadword from ymm2 and ymm3/m256 into ymm1 register. + +0F 60 /r PUNPCKLBW mm, mm/m32 RM RW, R V V MMX punpcklbw Interleave low-order bytes from mm and mm/m32 into mm. +66 0F 60 /r PUNPCKLBW xmm1, xmm2/m128 RM RW, R V V SSE2 punpcklbw Interleave low-order bytes from xmm1 and xmm2/m128 into xmm1. +0F 61 /r PUNPCKLWD mm, mm/m32 RM RW, R V V MMX punpcklwd Interleave low-order words from mm and mm/m32 into mm. +66 0F 61 /r PUNPCKLWD xmm1, xmm2/m128 RM RW, R V V SSE2 punpcklwd Interleave low-order words from xmm1 and xmm2/m128 into xmm1. +0F 62 /r PUNPCKLDQ mm, mm/m32 RM RW, R V V MMX punpckldq Interleave low-order doublewords from mm and mm/m32 into mm. +66 0F 62 /r PUNPCKLDQ xmm1, xmm2/m128 RM RW, R V V SSE2 punpckldq Interleave low-order doublewords from xmm1 and xmm2/m128 into xmm1. +66 0F 6C /r PUNPCKLQDQ xmm1, xmm2/m128 RM RW, R V V SSE2 punpcklqdq Interleave low-order quadword from xmm1 and xmm2/m128 into xmm1 register. +VEX.NDS.128.66.0F.WIG 60 /r VPUNPCKLBW xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpunpcklbw Interleave low-order bytes from xmm2 and xmm3/m128 into xmm1. +VEX.NDS.128.66.0F.WIG 61 /r VPUNPCKLWD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpunpcklwd Interleave low-order words from xmm2 and xmm3/m128 into xmm1. +VEX.NDS.128.66.0F.WIG 62 /r VPUNPCKLDQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpunpckldq Interleave low-order doublewords from xmm2 and xmm3/m128 into xmm1. +VEX.NDS.128.66.0F.WIG 6C /r VPUNPCKLQDQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpunpcklqdq Interleave low-order quadword from xmm2 and xmm3/m128 into xmm1 register. +VEX.NDS.256.66.0F.WIG 60 /r VPUNPCKLBW ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpunpcklbw Interleave low-order bytes from ymm2 and ymm3/m256 into ymm1 register. +VEX.NDS.256.66.0F.WIG 61 /r VPUNPCKLWD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpunpcklwd Interleave low-order words from ymm2 and ymm3/m256 into ymm1 register. +VEX.NDS.256.66.0F.WIG 62 /r VPUNPCKLDQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpunpckldq Interleave low-order doublewords from ymm2 and ymm3/m256 into ymm1 register. +VEX.NDS.256.66.0F.WIG 6C /r VPUNPCKLQDQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpunpcklqdq Interleave low-order quadword from ymm2 and ymm3/m256 into ymm1 register. + +FF /6 PUSH r/m16 M R RSP RSP V V pushw Push r/m16. +FF /6 PUSH r/m32 RSP RSP NE V Push r/m32. +FF /6 PUSH r/m64 M R RSP RSP V NE pushq Push r/m64. +50 +rw PUSH r16 O R RSP RSP V V pushw YES Push r16. +50 +rd PUSH r32 RSP RSP NE V Push r32. +50 +rd PUSH r64 O R RSP RSP V NE pushq YES Push r64. +6A PUSHQ imm8 I R RSP RSP V V pushq Push imm8 (sign-extended to 64-bits). +66 6A PUSHW imm8 I R RSP RSP V V pushw Push imm8 (sign-extended to 16-bits). +68 PUSHQ imm16 I R RSP RSP V V pushq Push imm16 (sign-extended to 64-bits). +66 68 PUSHW imm16 I R RSP RSP V V pushw Push imm16 (sign-extended to 16-bits). +68 PUSHQ imm32 I R RSP RSP V V pushq Push imm32 (sign-extended to 64-bits). +0E PUSH CS RSP RSP I V Push CS. +16 PUSH SS RSP RSP I V Push SS. +1E PUSH DS RSP RSP I V Push DS. +06 PUSH ES RSP RSP I V Push ES. +0F A0 PUSH FS NP R RSP RSP V V pushq Push FS. +0F A8 PUSH GS NP R RSP RSP V V pushq Push GS. + +60 PUSHA RSP RSP I V Push AX, CX, DX, BX, original SP, BP, SI, and DI. +60 PUSHAD RSP RSP I V Push EAX, ECX, EDX, EBX, original ESP, EBP, ESI, and EDI. + +66 9C PUSHF NP E.* RSP RSP V V pushfw Push lower 16 bits of EFLAGS. +9C PUSHFD NE V Push EFLAGS. +9C PUSHFQ NP E.* RSP RSP V NE pushfq Push RFLAGS. + +0F EF /r PXOR mm, mm/m64 RM RW, R V V MMX pxor Bitwise XOR of mm/m64 and mm. +66 0F EF /r PXOR xmm1, xmm2/m128 RM RW, R V V SSE2 pxor Bitwise XOR of xmm2/m128 and xmm1. +VEX.NDS.128.66.0F.WIG EF /r VPXOR xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpxor Bitwise XOR of xmm3/m128 and xmm2. +VEX.NDS.256.66.0F.WIG EF /r VPXOR ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpxor Bitwise XOR of ymm3/m256 and ymm2. + +D0 /2 RCL r/m8, 1 M1 RW, R E.CF E.CF E.OF V V rclb Rotate 9 bits (CF, r/m8) left once. +REX+ D0 /2 RCL r/m8, 1 M1 RW, R E.CF E.CF E.OF V NE rclb Rotate 9 bits (CF, r/m8) left once. +D2 /2 RCL r/m8, CL MC RW, R E.CF e.cf e.of e.of V V rclb Rotate 9 bits (CF, r/m8) left CL times. +REX+ D2 /2 RCL r/m8, CL MC RW, R E.CF e.cf e.of e.of V NE rclb Rotate 9 bits (CF, r/m8) left CL times. +C0 /2 ib RCL r/m8, imm8 MI RW, R E.CF e.cf e.of e.of V V rclb Rotate 9 bits (CF, r/m8) left imm8 times. +REX+ C0 /2 ib RCL r/m8, imm8 MI RW, R E.CF e.cf e.of e.of V NE rclb Rotate 9 bits (CF, r/m8) left imm8 times. +D1 /2 RCL r/m16, 1 M1 RW, R E.CF E.CF E.OF V V rclw Rotate 17 bits (CF, r/m16) left once. +D3 /2 RCL r/m16, CL MC RW, R E.CF e.cf e.of e.of V V rclw Rotate 17 bits (CF, r/m16) left CL times. +C1 /2 ib RCL r/m16, imm8 MI RW, R E.CF e.cf e.of e.of V V rclw Rotate 17 bits (CF, r/m16) left imm8 times. +D1 /2 RCL r/m32, 1 M1 RW, R E.CF E.CF E.OF V V rcll Rotate 33 bits (CF, r/m32) left once. +REX.W+ D1 /2 RCL r/m64, 1 M1 RW, R E.CF E.CF E.OF V NE rclq Rotate 65 bits (CF, r/m64) left once. Uses a 6 bit count. +D3 /2 RCL r/m32, CL MC RW, R E.CF e.cf e.of e.of V V rcll Rotate 33 bits (CF, r/m32) left CL times. +REX.W+ D3 /2 RCL r/m64, CL MC RW, R E.CF e.cf e.of e.of V NE rclq Rotate 65 bits (CF, r/m64) left CL times. Uses a 6 bit count. +C1 /2 ib RCL r/m32, imm8 MI RW, R E.CF e.cf e.of e.of V V rcll Rotate 33 bits (CF, r/m32) left imm8 times. +REX.W+ C1 /2 ib RCL r/m64, imm8 MI RW, R E.CF e.cf e.of e.of V NE rclq Rotate 65 bits (CF, r/m64) left imm8 times. Uses a 6 bit count. +D0 /3 RCR r/m8, 1 M1 RW, R E.CF E.CF E.OF V V rcrb Rotate 9 bits (CF, r/m8) right once. +REX+ D0 /3 RCR r/m8, 1 M1 RW, R E.CF E.CF E.OF V NE rcrb Rotate 9 bits (CF, r/m8) right once. +D2 /3 RCR r/m8, CL MC RW, R E.CF e.cf e.of e.of V V rcrb Rotate 9 bits (CF, r/m8) right CL times. +REX+ D2 /3 RCR r/m8, CL MC RW, R E.CF e.cf e.of e.of V NE rcrb Rotate 9 bits (CF, r/m8) right CL times. +C0 /3 ib RCR r/m8, imm8 MI RW, R E.CF e.cf e.of e.of V V rcrb Rotate 9 bits (CF, r/m8) right imm8 times. +REX+ C0 /3 ib RCR r/m8, imm8 MI RW, R E.CF e.cf e.of e.of V NE rcrb Rotate 9 bits (CF, r/m8) right imm8 times. +D1 /3 RCR r/m16, 1 M1 RW, R E.CF E.CF E.OF V V rcrw Rotate 17 bits (CF, r/m16) right once. +D3 /3 RCR r/m16, CL MC RW, R E.CF e.cf e.of e.of V V rcrw Rotate 17 bits (CF, r/m16) right CL times. +C1 /3 ib RCR r/m16, imm8 MI RW, R E.CF e.cf e.of e.of V V rcrw Rotate 17 bits (CF, r/m16) right imm8 times. +D1 /3 RCR r/m32, 1 M1 RW, R E.CF E.CF E.OF V V rcrl Rotate 33 bits (CF, r/m32) right once. Uses a 6 bit count. +REX.W+ D1 /3 RCR r/m64, 1 M1 RW, R E.CF E.CF E.OF V NE rcrq Rotate 65 bits (CF, r/m64) right once. Uses a 6 bit count. +D3 /3 RCR r/m32, CL MC RW, R E.CF e.cf e.of e.of V V rcrl Rotate 33 bits (CF, r/m32) right CL times. +REX.W+ D3 /3 RCR r/m64, CL MC RW, R E.CF e.cf e.of e.of V NE rcrq Rotate 65 bits (CF, r/m64) right CL times. Uses a 6 bit count. +C1 /3 ib RCR r/m32, imm8 MI RW, R E.CF e.cf e.of e.of V V rcrl Rotate 33 bits (CF, r/m32) right imm8 times. +REX.W+ C1 /3 ib RCR r/m64, imm8 MI RW, R E.CF e.cf e.of e.of V NE rcrq Rotate 65 bits (CF, r/m64) right imm8 times. Uses a 6 bit count. +D0 /0 ROL r/m8, 1 M1 RW, R E.CF E.OF V V rolb Rotate 8 bits r/m8 left once. +REX+ D0 /0 ROL r/m8, 1 M1 RW, R E.CF E.OF V NE rolb Rotate 8 bits r/m8 left once. +D2 /0 ROL r/m8, CL MC RW, R e.cf e.of e.of V V rolb Rotate 8 bits r/m8 left CL times. +REX+ D2 /0 ROL r/m8, CL MC RW, R e.cf e.of e.of V NE rolb Rotate 8 bits r/m8 left CL times. +C0 /0 ib ROL r/m8, imm8 MI RW, R e.cf e.of e.of V V rolb Rotate 8 bits r/m8 left imm8 times. +REX+ C0 /0 ib ROL r/m8, imm8 MI RW, R e.cf e.of e.of V NE rolb Rotate 8 bits r/m8 left imm8 times. +D1 /0 ROL r/m16, 1 M1 RW, R E.CF E.OF V V rolw Rotate 16 bits r/m16 left once. +D3 /0 ROL r/m16, CL MC RW, R e.cf e.of e.of V V rolw Rotate 16 bits r/m16 left CL times. +C1 /0 ib ROL r/m16, imm8 MI RW, R e.cf e.of e.of V V rolw Rotate 16 bits r/m16 left imm8 times. +D1 /0 ROL r/m32, 1 M1 RW, R E.CF E.OF V V roll Rotate 32 bits r/m32 left once. +REX.W+ D1 /0 ROL r/m64, 1 M1 RW, R E.CF E.OF V NE rolq Rotate 64 bits r/m64 left once. Uses a 6 bit count. +D3 /0 ROL r/m32, CL MC RW, R e.cf e.of e.of V V roll Rotate 32 bits r/m32 left CL times. +REX.W+ D3 /0 ROL r/m64, CL MC RW, R e.cf e.of e.of V NE rolq Rotate 64 bits r/m64 left CL times. Uses a 6 bit count. +C1 /0 ib ROL r/m32, imm8 MI RW, R e.cf e.of e.of V V roll Rotate 32 bits r/m32 left imm8 times. +REX.W+ C1 /0 ib ROL r/m64, imm8 MI RW, R e.cf e.of e.of V NE rolq Rotate 64 bits r/m64 left imm8 times. Uses a 6 bit count. +D0 /1 ROR r/m8, 1 M1 RW, R E.CF E.OF V V rorb Rotate 8 bits r/m8 right once. +REX+ D0 /1 ROR r/m8, 1 M1 RW, R E.CF E.OF V NE rorb Rotate 8 bits r/m8 right once. +D2 /1 ROR r/m8, CL MC RW, R e.cf e.of e.of V V rorb Rotate 8 bits r/m8 right CL times. +REX+ D2 /1 ROR r/m8, CL MC RW, R e.cf e.of e.of V NE rorb Rotate 8 bits r/m8 right CL times. +C0 /1 ib ROR r/m8, imm8 MI RW, R e.cf e.of e.of V V rorb Rotate 8 bits r/m16 right imm8 times. +REX+ C0 /1 ib ROR r/m8, imm8 MI RW, R e.cf e.of e.of V NE rorb Rotate 8 bits r/m16 right imm8 times. +D1 /1 ROR r/m16, 1 M1 RW, R E.CF E.OF V V rorw Rotate 16 bits r/m16 right once. +D3 /1 ROR r/m16, CL MC RW, R e.cf e.of e.of V V rorw Rotate 16 bits r/m16 right CL times. +C1 /1 ib ROR r/m16, imm8 MI RW, R e.cf e.of e.of V V rorw Rotate 16 bits r/m16 right imm8 times. +D1 /1 ROR r/m32, 1 M1 RW, R E.CF E.OF V V rorl Rotate 32 bits r/m32 right once. +REX.W+ D1 /1 ROR r/m64, 1 M1 RW, R E.CF E.OF V NE rorq Rotate 64 bits r/m64 right once. Uses a 6 bit count. +D3 /1 ROR r/m32, CL MC RW, R e.cf e.of e.of V V rorl Rotate 32 bits r/m32 right CL times. +REX.W+ D3 /1 ROR r/m64, CL MC RW, R e.cf e.of e.of V NE rorq Rotate 64 bits r/m64 right CL times. Uses a 6 bit count. +C1 /1 ib ROR r/m32, imm8 MI RW, R e.cf e.of e.of V V rorl Rotate 32 bits r/m32 right imm8 times. +REX.W+ C1 /1 ib ROR r/m64, imm8 MI RW, R e.cf e.of e.of V NE rorq Rotate 64 bits r/m64 right imm8 times. Uses a 6 bit count. + +0F 53 /r RCPPS xmm1, xmm2/m128 RM W, R V V SSE rcpps Computes the approximate reciprocals of the packed single-precision floating-point values in xmm2/m128 and stores the results in xmm1. +VEX.128.0F.WIG 53 /r VRCPPS xmm1, xmm2/m128 RM Z, R V V AVX vrcpps Computes the approximate reciprocals of packed single-precision values in xmm2/mem and stores the results in xmm1. +VEX.256.0F.WIG 53 /r VRCPPS ymm1, ymm2/m256 RM W, R V V AVX vrcpps Computes the approximate reciprocals of packed single-precision values in ymm2/mem and stores the results in ymm1. + +F3 0F 53 /r RCPSS xmm1, xmm2/m32 RM RW, R V V SSE rcpss Computes the approximate reciprocal of the scalar single-precision floating-point value in xmm2/m32 and stores the result in xmm1. +VEX.NDS.LIG.F3.0F.WIG 53 /r VRCPSS xmm1, xmm2, xmm3/m32 RVM Z, R, R V V AVX vrcpss Computes the approximate reciprocal of the scalar single-precision floating-point value in xmm3/m32 and stores the result in xmm1. Also, upper single precision floating-point values (bits[127:32]) from xmm2 are copied to xmm1[127:32]. + +F3 0F AE /0 RDFSBASE r32 M W V I FSGSBASE rdfsbase Load the 32-bit destination register with the FS base address. +REX.W+ F3 0F AE /0 RDFSBASE r64 M W V I FSGSBASE rdfsbase Load the 64-bit destination register with the FS base address. +F3 0F AE /1 RDGSBASE r32 M W V I FSGSBASE rdgsbase Load the 32-bit destination register with the GS base address. +REX.W+ F3 0F AE /1 RDGSBASE r64 M W V I FSGSBASE rdgsbase Load the 64-bit destination register with the GS base address. + +0F 32 RDMSR NO YES V V MSR Read MSR specified by ECX into EDX:EAX. + +0F 33 RDPMC YES YES* V V MSR Read performance-monitoring counter specified by ECX into EDX:EAX. + +0F C7 /6 RDRAND r16 M W E.CF E.OF E.SF E.ZF E.AF E.PF V V RDRAND rdrand Read a 16-bit random number and store in the destination register. +0F C7 /6 RDRAND r32 M W E.CF E.OF E.SF E.ZF E.AF E.PF V V RDRAND rdrand Read a 32-bit random number and store in the destination register. +REX.W+ 0F C7 /6 RDRAND r64 M W E.CF E.OF E.SF E.ZF E.AF E.PF V I RDRAND rdrand Read a 64-bit random number and store in the destination register. + +0F 31 RDTSC YES YES* V V TSC Read time-stamp counter into EDX:EAX. + +0F 01 F9 RDTSCP YES YES* V V RDTSCP Read 64-bit time-stamp counter and 32-bit IA32_TSC_AUX value into EDX:EAX and ECX. + +F3 6C REP_INS m8, DX NP I, R ECX E.IOPL E.VM E.DF RDI V V REP_GOOD rep insb YES Input (E)CX bytes from port DX into ES:[(E)DI]. +F3 REX.W+ 6C REP_INS m8, DX NP I, R RCX E.IOPL E.VM E.DF RDI V NE REP_GOOD rep insb Input RCX bytes from port DX into [RDI]. +F3 6D REP_INS m16, DX NP I, R ECX E.IOPL E.VM E.DF RDI V V REP_GOOD rep insw YES Input (E)CX words from port DX into ES:[(E)DI.] +F3 6D REP_INS m32, DX NP I, R ECX E.IOPL E.VM E.DF RDI V V REP_GOOD rep insl YES Input (E)CX doublewords from port DX into ES:[(E)DI]. +F3 REX.W+ 6D REP_INS m64, DX NP I, R RCX E.IOPL E.VM E.DF RDI V NE REP_GOOD rep insq Input RCX default size from port DX into [RDI]. +F3 A4 REP_MOVS m8, m8 NP I, I ECX E.DF ESI rsi EDI rdi V V REP_GOOD rep movsb YES Move (E)CX bytes from DS:[(E)SI] to ES:[(E)DI]. +F3 REX.W+ A4 REP_MOVS m8, m8 NP I, I RCX E.DF ESI rsi EDI rdi V NE REP_GOOD rep movsb Move RCX bytes from [RSI] to [RDI]. +F3 A5 REP_MOVS m16, m16 NP I, I ECX E.DF ESI rsi EDI rdi V V REP_GOOD rep movsw YES Move (E)CX words from DS:[(E)SI] to ES:[(E)DI]. +F3 A5 REP_MOVS m32, m32 NP I, I ECX E.DF ESI rsi EDI rdi V V REP_GOOD rep movsl YES Move (E)CX doublewords from DS:[(E)SI] to ES:[(E)DI]. +F3 REX.W+ A5 REP_MOVS m64, m64 NP I, I RCX E.DF ESI rsi EDI rdi V NE REP_GOOD rep movsq Move RCX quadwords from [RSI] to [RDI]. +F3 6E REP_OUTS DX, m8 NP R, I ECX E.IOPL E.VM E.DF RSI V V REP_GOOD rep outsb YES Output (E)CX bytes from DS:[(E)SI] to port DX. +F3 REX.W+ 6E REP_OUTS DX, m8 NP R, I RCX E.IOPL E.VM E.DF RSI V NE REP_GOOD rep outsb Output RCX bytes from [RSI] to port DX. +F3 6F REP_OUTS DX, m16 NP R, I ECX E.IOPL E.VM E.DF RSI V V REP_GOOD rep outsw YES Output (E)CX words from DS:[(E)SI] to port DX. +F3 6F REP_OUTS DX, m32 NP R, I ECX E.IOPL E.VM E.DF RSI V V REP_GOOD rep outsl YES Output (E)CX doublewords from DS:[(E)SI] to port DX. +F3 REX.W+ 6F REP_OUTS DX, m64 NP R, I RCX E.IOPL E.VM E.DF RSI V NE REP_GOOD rep outsq Output RCX default size from [RSI] to port DX. +F3 AC REP_LODS AL NP W ECX E.DF SI rsi V V REP_GOOD rep lodsb YES Load (E)CX bytes from DS:[(E)SI] to AL. +F3 REX.W+ AC REP_LODS AL NP W RCX E.DF SI rsi V NE REP_GOOD rep lodsb Load RCX bytes from [RSI] to AL. +F3 AD REP_LODS AX NP W ECX E.DF SI rsi V V REP_GOOD rep lodsw YES Load (E)CX words from DS:[(E)SI] to AX. +F3 AD REP_LODS EAX NP W ECX E.DF SI rsi V V REP_GOOD rep lodsl YES Load (E)CX doublewords from DS:[(E)SI] to EAX. +F3 REX.W+ AD REP_LODS RAX NP W RCX E.DF SI rsi V NE REP_GOOD rep lodsq Load RCX quadwords from [RSI] to RAX. +F3 AA REP_STOS m8 NP I ECX E.DF RDI AL V V REP_GOOD rep stosb YES Fill (E)CX bytes at ES:[(E)DI] with AL. +F3 REX.W+ AA REP_STOS m8 NP I RCX E.DF RDI AL V NE REP_GOOD rep stosb Fill RCX bytes at [RDI] with AL. +F3 AB REP_STOS m16 NP I ECX E.DF RDI AL V V REP_GOOD rep stosw YES Fill (E)CX words at ES:[(E)DI] with AX. +F3 AB REP_STOS m32 NP I ECX E.DF RDI AL V V REP_GOOD rep stosl YES Fill (E)CX doublewords at ES:[(E)DI] with EAX. +F3 REX.W+ AB REP_STOS m64 NP I RCX E.DF RDI AL V NE REP_GOOD rep stosq Fill RCX quadwords at [RDI] with RAX. +F3 A6 REPE_CMPS m8, m8 NP I, I E.ZF E.DF ESI rsi EDI rdi V V REP_GOOD repz cmpsb YES Find nonmatching bytes in ES:[(E)DI] and DS:[(E)SI]. +F3 REX.W+ A6 REPE_CMPS m8, m8 NP I, I E.ZF E.DF ESI rsi EDI rdi V NE REP_GOOD repz cmpsb Find non-matching bytes in [RDI] and [RSI]. +F3 A7 REPE_CMPS m16, m16 NP I, I E.ZF E.DF ESI rsi EDI rdi V V REP_GOOD repz cmpsw YES Find nonmatching words in ES:[(E)DI] and DS:[(E)SI]. +F3 A7 REPE_CMPS m32, m32 NP I, I E.ZF E.DF ESI rsi EDI rdi V V REP_GOOD repz cmpsl YES Find nonmatching doublewords in ES:[(E)DI] and DS:[(E)SI]. +F3 REX.W+ A7 REPE_CMPS m64, m64 NP I, I E.ZF E.DF ESI rsi EDI rdi V NE REP_GOOD repz cmpsq Find non-matching quadwords in [RDI] and [RSI]. +F3 AE REPE_SCAS m8 NP I E.ZF E.DF RDI AL V V REP_GOOD repz scasb YES Find non-AL byte starting at ES:[(E)DI]. +F3 REX.W+ AE REPE_SCAS m8 NP I E.ZF E.DF RDI AL V NE REP_GOOD repz scasb Find non-AL byte starting at [RDI]. +F3 AF REPE_SCAS m16 NP I E.ZF E.DF RDI AX V V REP_GOOD repz scasw YES Find non-AX word starting at ES:[(E)DI]. +F3 AF REPE_SCAS m32 NP I E.ZF E.DF RDI EAX V V REP_GOOD repz scasl YES Find non-EAX doubleword starting at ES:[(E)DI]. +F3 REX.W+ AF REPE_SCAS m64 NP I E.ZF E.DF RDI RAX V NE REP_GOOD repz scasq Find non-RAX quadword starting at [RDI]. +F2 A6 REPNE_CMPS m8, m8 NP I, I E.ZF E.DF ESI rsi EDI rdi V V REP_GOOD repnz cmpsb YES Find matching bytes in ES:[(E)DI] and DS:[(E)SI]. +F2 REX.W+ A6 REPNE_CMPS m8, m8 NP I, I E.ZF E.DF ESI rsi EDI rdi V NE REP_GOOD repnz cmpsb Find matching bytes in [RDI] and [RSI]. +F2 A7 REPNE_CMPS m16, m16 NP I, I E.ZF E.DF ESI rsi EDI rdi V V REP_GOOD repnz cmpsw YES Find matching words in ES:[(E)DI] and DS:[(E)SI]. +F2 A7 REPNE_CMPS m32, m32 NP I, I E.ZF E.DF ESI rsi EDI rdi V V REP_GOOD repnz cmpsl YES Find matching doublewords in ES:[(E)DI] and DS:[(E)SI]. +F2 REX.W+ A7 REPNE_CMPS m64, m64 NP I, I E.ZF E.DF ESI rsi EDI rdi V NE REP_GOOD repnz cmpsq Find matching doublewords in [RDI] and [RSI]. +F2 AE REPNE_SCAS m8 NP I E.ZF E.DF RDI AL V V REP_GOOD repnz scasb YES Find AL, starting at ES:[(E)DI]. +F2 REX.W+ AE REPNE_SCAS m8 NP I E.ZF E.DF RDI AL V NE REP_GOOD repnz scasb Find AL, starting at [RDI]. +F2 AF REPNE_SCAS m16 NP I E.ZF E.DF RDI AX V V REP_GOOD repnz scasw YES Find AX, starting at ES:[(E)DI]. +F2 AF REPNE_SCAS m32 NP I E.ZF E.DF RDI EAX V V REP_GOOD repnz scasl YES Find EAX, starting at ES:[(E)DI]. +F2 REX.W+ AF REPNE_SCAS m64 NP I E.ZF E.DF RDI RAX V NE REP_GOOD repnz scasq Find RAX, starting at [RDI]. + +C3 RET NP RIP V V retq Near return to calling procedure. +CB RET far NP I ??? ??? ??? V V lretl Far return to calling procedure. +C2 iw RET imm16 I R RIP RSP V V retq Near return to calling procedure and pop imm16 bytes from stack. +CA iw RET imm16, far I R, I ??? ??? ??? V V retq Far return to calling procedure and pop imm16 bytes from stack. + +VEX.LZ.F2.0F3A.W0 F0 /r ib RORX r32, r/m32, imm8 RMI W, R, R V V BMI2 rorxl Rotate 32-bit r/m32 right imm8 times without affecting arithmetic flags. +VEX.LZ.F2.0F3A.W1 F0 /r ib RORX r64, r/m64, imm8 RMI W, R, R V NE BMI2 rorxq Rotate 64-bit r/m64 right imm8 times without affecting arithmetic flags. + +66 0F 3A 09 /r ib ROUNDPD xmm1, xmm2/m128, imm8 RMI W, R, R M.RC V V SSE4_1 roundpd Round packed double precision floating-point values in xmm2/m128 and place the result in xmm1. The rounding mode is determined by imm8. +VEX.128.66.0F3A.WIG 09 /r ib VROUNDPD xmm1, xmm2/m128, imm8 RMI Z, R, R M.RC V V AVX vroundpd Round packed double-precision floating-point values in xmm2/m128 and place the result in xmm1. The rounding mode is determined by imm8. +VEX.256.66.0F3A.WIG 09 /r ib VROUNDPD ymm1, ymm2/m256, imm8 RMI W, R, R M.RC V V AVX vroundpd Round packed double-precision floating-point values in ymm2/m256 and place the result in ymm1. The rounding mode is determined by imm8. + +66 0F 3A 08 /r ib ROUNDPS xmm1, xmm2/m128, imm8 RMI W, R, R M.RC V V SSE4_1 roundps Round packed single precision floating-point values in xmm2/m128 and place the result in xmm1. The rounding mode is determined by imm8. +VEX.128.66.0F3A.WIG 08 /r ib VROUNDPS xmm1, xmm2/m128, imm8 RMI Z, R, R M.RC V V AVX vroundps Round packed single-precision floating-point values in xmm2/m128 and place the result in xmm1. The rounding mode is determined by imm8. +VEX.256.66.0F3A.WIG 08 /r ib VROUNDPS ymm1, ymm2/m256, imm8 RMI W, R, R M.RC V V AVX vroundps Round packed single-precision floating-point values in ymm2/m256 and place the result in ymm1. The rounding mode is determined by imm8. + +66 0F 3A 0B /r ib ROUNDSD xmm1, xmm2/m64, imm8 RMI RW, R, R M.RC V V SSE4_1 roundsd Round the low packed double precision floating-point value in xmm2/m64 and place the result in xmm1. The rounding mode is determined by imm8. +VEX.NDS.LIG.66.0F3A.WIG 0B /r ib VROUNDSD xmm1, xmm2, xmm3/m64, imm8 RVMI Z, R, R, R M.RC V V AVX vroundsd Round the low packed double precision floating-point value in xmm3/m64 and place the result in xmm1. The rounding mode is determined by imm8. Upper packed double precision floating-point value (bits[127:64]) from xmm2 is copied to xmm1[127:64]. + +66 0F 3A 0A /r ib ROUNDSS xmm1, xmm2/m32, imm8 RMI RW, R, R M.RC V V SSE4_1 roundss Round the low packed single precision floating-point value in xmm2/m32 and place the result in xmm1. The rounding mode is determined by imm8. +VEX.NDS.LIG.66.0F3A.WIG 0A ib VROUNDSS xmm1, xmm2, xmm3/m32, imm8 RVMI Z, R, R, R M.RC V V AVX vroundss Round the low packed single precision floating-point value in xmm3/m32 and place the result in xmm1. The rounding mode is determined by imm8. Also, upper packed single precision floating-point values (bits[127:32]) from xmm2 are copied to xmm1[127:32]. + +0F AA RSM NO YES I V Resume operation of interrupted program. + +0F 52 /r RSQRTPS xmm1, xmm2/m128 RM W, R V V SSE rsqrtps Computes the approximate reciprocals of the square roots of the packed single-precision floating-point values in xmm2/m128 and stores the results in xmm1. +VEX.128.0F.WIG 52 /r VRSQRTPS xmm1, xmm2/m128 RM Z, R V V AVX vrsqrtps Computes the approximate reciprocals of the square roots of packed single-precision values in xmm2/mem and stores the results in xmm1. +VEX.256.0F.WIG 52 /r VRSQRTPS ymm1, ymm2/m256 RM W, R V V AVX vrsqrtps Computes the approximate reciprocals of the square roots of packed single-precision values in ymm2/mem and stores the results in ymm1. + +F3 0F 52 /r RSQRTSS xmm1, xmm2/m32 RM RW, R V V SSE rsqrtss Computes the approximate reciprocal of the square root of the low single-precision floating-point value in xmm2/m32 and stores the results in xmm1. +VEX.NDS.LIG.F3.0F.WIG 52 /r VRSQRTSS xmm1, xmm2, xmm3/m32 RVM Z, R, R V V AVX vrsqrtss Computes the approximate reciprocal of the square root of the low single precision floating-point value in xmm3/m32 and stores the results in xmm1. Also, upper single precision floating-point values (bits[127:32]) from xmm2 are copied to xmm1[127:32]. + +9E SAHF NP AH E.SF E.ZF E.AF E.PF E.CF V V LAHF_LM sahf Loads SF, ZF, AF, PF, and CF from AH into EFLAGS register. + +D0 /4 SAL r/m8, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V salb Multiply r/m8 by 2, once. +REX+ D0 /4 SAL r/m8, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V NE salb Multiply r/m8 by 2, once. +D2 /4 SAL r/m8, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.of e.af e.cf V V salb Multiply r/m8 by 2, CL times. +REX+ D2 /4 SAL r/m8, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.of e.af e.cf V NE salb Multiply r/m8 by 2, CL times. +C0 /4 ib SAL r/m8, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.of e.af e.cf V V salb Multiply r/m8 by 2, imm8 times. +REX+ C0 /4 ib SAL r/m8, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.of e.af e.cf V NE salb Multiply r/m8 by 2, imm8 times. +D1 /4 SAL r/m16, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V salw Multiply r/m16 by 2, once. +D3 /4 SAL r/m16, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.of e.af e.cf V V salw Multiply r/m16 by 2, CL times. +C1 /4 ib SAL r/m16, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.of e.af e.cf V V salw Multiply r/m16 by 2, imm8 times. +D1 /4 SAL r/m32, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V sall Multiply r/m32 by 2, once. +REX.W+ D1 /4 SAL r/m64, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V NE salq Multiply r/m64 by 2, once. +D3 /4 SAL r/m32, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.of e.af e.cf V V sall Multiply r/m32 by 2, CL times. +REX.W+ D3 /4 SAL r/m64, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.of e.af e.cf V NE salq Multiply r/m64 by 2, CL times. +C1 /4 ib SAL r/m32, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.of e.af e.cf V V sall Multiply r/m32 by 2, imm8 times. +REX.W+ C1 /4 ib SAL r/m64, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.of e.af e.cf V NE salq Multiply r/m64 by 2, imm8 times. +D0 /7 SAR r/m8, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V sarb Signed divide r/m8 by 2, once. +REX+ D0 /7 SAR r/m8, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V NE sarb Signed divide r/m8 by 2, once. +D2 /7 SAR r/m8, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.of e.af V V sarb Signed divide r/m8 by 2, CL times. +REX+ D2 /7 SAR r/m8, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.of e.af V NE sarb Signed divide r/m8 by 2, CL times. +C0 /7 ib SAR r/m8, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.of e.af V V sarb Signed divide r/m8 by 2, imm8 time. +REX+ C0 /7 ib SAR r/m8, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.of e.af V NE sarb Signed divide r/m8 by 2, imm8 time. +D1 /7 SAR r/m16,1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V sarw Signed divide r/m16 by 2, once. +D3 /7 SAR r/m16, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.of e.af V V sarw Signed divide r/m16 by 2, CL times. +C1 /7 ib SAR r/m16, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.of e.af V V sarw Signed divide r/m16 by 2, imm8 times. +D1 /7 SAR r/m32, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V sarl Signed divide r/m32 by 2, once. +REX.W+ D1 /7 SAR r/m64, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V NE sarq Signed divide r/m32 by 2, once. +D3 /7 SAR r/m32, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.of e.af V V sarl Signed divide r/m32 by 2, CL times. +REX.W+ D3 /7 SAR r/m64, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.of e.af V NE sarq Signed divide r/m32 by 2, CL times. +C1 /7 ib SAR r/m32, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.of e.af V V sarl Signed divide r/m32 by 2, imm8 times. +REX.W+ C1 /7 ib SAR r/m64, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.of e.af V NE sarq Signed divide r/m32 by 2, imm8 times. +D0 /4 SHL r/m8, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V shlb Multiply r/m8 by 2, once. +REX+ D0 /4 SHL r/m8, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V NE shlb Multiply r/m8 by 2, once. +D2 /4 SHL r/m8, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shlb Multiply r/m8 by 2, CL times. +REX+ D2 /4 SHL r/m8, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V NE shlb Multiply r/m8 by 2, CL times. +C0 /4 ib SHL r/m8, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shlb Multiply r/m8 by 2, imm8 times. +REX+ C0 /4 ib SHL r/m8, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V NE shlb Multiply r/m8 by 2, imm8 times. +D1 /4 SHL r/m16,1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V shlw Multiply r/m16 by 2, once. +D3 /4 SHL r/m16, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shlw Multiply r/m16 by 2, CL times. +C1 /4 ib SHL r/m16, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shlw Multiply r/m16 by 2, imm8 times. +D1 /4 SHL r/m32,1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V shll Multiply r/m32 by 2, once. +REX.W+ D1 /4 SHL r/m64,1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V NE shlq Multiply r/m64 by 2, once. +D3 /4 SHL r/m32, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shll Multiply r/m32 by 2, CL times. +REX.W+ D3 /4 SHL r/m64, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V NE shlq Multiply r/m32 by 2, CL times. +C1 /4 ib SHL r/m32, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shll Multiply r/m32 by 2, imm8 times. +REX.W+ C1 /4 ib SHL r/m64, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V NE shlq Multiply r/m32 by 2, imm8 times. +D0 /5 SHR r/m8,1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V shrb Unsigned divide r/m8 by 2, once. +REX+ D0 /5 SHR r/m8, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V NE shrb Unsigned divide r/m8 by 2, once. +D2 /5 SHR r/m8, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shrb Unsigned divide r/m8 by 2, CL times. +REX+ D2 /5 SHR r/m8, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V NE shrb Unsigned divide r/m8 by 2, CL times. +C0 /5 ib SHR r/m8, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shrb Unsigned divide r/m8 by 2, imm8 times. +REX+ C0 /5 ib SHR r/m8, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V NE shrb Unsigned divide r/m8 by 2, imm8 times. +D1 /5 SHR r/m16, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V shrw Unsigned divide r/m16 by 2, once. +D3 /5 SHR r/m16, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shrw Unsigned divide r/m16 by 2, CL times +C1 /5 ib SHR r/m16, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shrw Unsigned divide r/m16 by 2, imm8 times. +D1 /5 SHR r/m32, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V V shrl Unsigned divide r/m32 by 2, once. +REX.W+ D1 /5 SHR r/m64, 1 M1 RW, R E.CF E.OF E.PF E.SF E.ZF E.AF V NE shrq Unsigned divide r/m32 by 2, once. +D3 /5 SHR r/m32, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shrl Unsigned divide r/m32 by 2, CL times. +REX.W+ D3 /5 SHR r/m64, CL MC RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V NE shrq Unsigned divide r/m32 by 2, CL times. +C1 /5 ib SHR r/m32, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V V shrl Unsigned divide r/m32 by 2, imm8 times. +REX.W+ C1 /5 ib SHR r/m64, imm8 MI RW, R e.cf e.of e.pf e.sf e.zf e.cf e.of e.af V NE shrq Unsigned divide r/m32 by 2, imm8 times. + +VEX.NDS.LZ.F3.0F38.W0 F7 /r SARX r32a, r/m32, r32b RMV W, R, R V V BMI2 sarxl Shift r/m32 arithmetically right with count specified in r32b +VEX.NDS.LZ.66.0F38.W0 F7 /r SHLX r32a, r/m32, r32b RMV W, R, R V V BMI2 shlxl Shift r/m32 logically left with count specified in r32b +VEX.NDS.LZ.F2.0F38.W0 F7 /r SHRX r32a, r/m32, r32b RMV W, R, R V V BMI2 shrxl Shift r/m32 logically right with count specified in r32b +VEX.NDS.LZ.F3.0F38.W1 F7 /r SARX r64a, r/m64, r64b RMV W, R, R V NE BMI2 sarxq Shift r/m64 arithmetically right with count specified in r64b +VEX.NDS.LZ.66.0F38.W1 F7 /r SHLX r64a, r/m64, r64b RMV W, R, R V NE BMI2 shlxq Shift r/m64 logically left with count specified in r64b. +VEX.NDS.LZ.F2.0F38.W1 F7 /r SHRX r64a, r/m64, r64b RMV W, R, R V NE BMI2 shrxq Shift r/m64 logically right with count specified in r64b + +1C ib SBB AL, imm8 I RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbb Subtract with borrow imm8 from AL. +1D iw SBB AX, imm16 I RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbw Subtract with borrow imm16 from AX. +1D id SBB EAX, imm32 I RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbl Subtract with borrow imm32 from EAX. +REX.W+ 1D id SBB RAX, imm32 I RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V NE sbbq Subtract with borrow sign-extended imm.32 to 64-bits from RAX. +80 /3 ib SBB r/m8, imm8 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbb Subtract with borrow imm8 from r/m8. +REX+ 80 /3 ib SBB r/m8, imm8 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V NE sbbb Subtract with borrow imm8 from r/m8. +81 /3 iw SBB r/m16, imm16 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbw Subtract with borrow imm16 from r/m16. +81 /3 id SBB r/m32, imm32 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbl Subtract with borrow imm32 from r/m32. +REX.W+ 81 /3 id SBB r/m64, imm32 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V NE sbbq Subtract with borrow sign-extended imm32 to 64-bits from r/m64. +83 /3 ib SBB r/m16, imm8 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbw YES Subtract with borrow sign-extended imm8 from r/m16. +83 /3 ib SBB r/m32, imm8 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbl YES Subtract with borrow sign-extended imm8 from r/m32. +REX.W+ 83 /3 ib SBB r/m64, imm8 MI RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V NE sbbq YES Subtract with borrow sign-extended imm8 from r/m64. +18 /r SBB r/m8, r8 MR RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbb YES Subtract with borrow r8 from r/m8. +REX+ 18 /r SBB r/m8, r8 MR RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V NE sbbb YES Subtract with borrow r8 from r/m8. +19 /r SBB r/m16, r16 MR RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbw YES Subtract with borrow r16 from r/m16. +19 /r SBB r/m32, r32 MR RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbl YES Subtract with borrow r32 from r/m32. +REX.W+ 19 /r SBB r/m64, r64 MR RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V NE sbbq YES Subtract with borrow r64 from r/m64. +1A /r SBB r8, r/m8 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbb Subtract with borrow r/m8 from r8. +REX+ 1A /r SBB r8, r/m8 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V NE sbbb Subtract with borrow r/m8 from r8. +1B /r SBB r16, r/m16 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbw Subtract with borrow r/m16 from r16. +1B /r SBB r32, r/m32 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V V sbbl Subtract with borrow r/m32 from r32. +REX.W+ 1B /r SBB r64, r/m64 RM RW, R E.CF E.OF E.SF E.ZF E.AF E.PF E.CF V NE sbbq Subtract with borrow r/m64 from r64. + +AE SCAS m8 NP I E.DF RDI AL V V scas Compare AL with byte at ES:(E)DI or RDI, then set status flags. +AF SCAS m16 NP I E.DF RDI AX V V scas Compare AX with word at ES:(E)DI or RDI, then set status flags. +AF SCAS m32 NP I E.DF RDI EAX V V scas Compare EAX with doubleword at ES(E)DI or RDI then set status flags. +REX.W+ AF SCAS m64 NP I E.DF RDI RAX V NE scas Compare RAX with quadword at RDI or EDI then set status flags. +AE SCASB NP E.DF RDI AL V V scasb Compare AL with byte at ES:(E)DI or RDI then set status flags. +PREF.66+ AF SCASW NP E.DF RDI AX V V scasw Compare AX with word at ES:(E)DI or RDI then set status flags. +AF SCASD NP E.DF RDI EAX V V scasl Compare EAX with doubleword at ES:(E)DI or RDI then set status flags. +REX.W+ AF SCASQ NP E.DF RDI RAX V NE scasq Compare RAX with quadword at RDI or EDI then set status flags. + +0F 97 /0 SETA r/m8 M W E.CF E.ZF V V seta Set byte if above (CF=0 and ZF=0). +REX+ 0F 97 /0 SETA r/m8 M W E.CF E.ZF V NE seta Set byte if above (CF=0 and ZF=0). +0F 93 /0 SETAE r/m8 M W E.CF V V setae Set byte if above or equal (CF=0). +REX+ 0F 93 /0 SETAE r/m8 M W E.CF V NE setae Set byte if above or equal (CF=0). +0F 92 /0 SETB r/m8 M W E.CF V V setb Set byte if below (CF=1). +REX+ 0F 92 /0 SETB r/m8 M W E.CF V NE setb Set byte if below (CF=1). +0F 96 /0 SETBE r/m8 M W E.CF E.ZF V V setbe Set byte if below or equal (CF=1 or ZF=1). +REX+ 0F 96 /0 SETBE r/m8 M W E.CF E.ZF V NE setbe Set byte if below or equal (CF=1 or ZF=1). +0F 92 /0 SETC r/m8 M W E.CF V V setc Set byte if carry (CF=1). +REX+ 0F 92 /0 SETC r/m8 M W E.CF V NE setc Set byte if carry (CF=1). +0F 94 /0 SETE r/m8 M W E.ZF V V sete Set byte if equal (ZF=1). +REX+ 0F 94 /0 SETE r/m8 M W E.ZF V NE sete Set byte if equal (ZF=1). +0F 9F /0 SETG r/m8 M W E.ZF E.SF E.OF V V setg Set byte if greater (ZF=0 and SF=OF). +REX+ 0F 9F /0 SETG r/m8 M W E.ZF E.SF E.OF V NE setg Set byte if greater (ZF=0 and SF=OF). +0F 9D /0 SETGE r/m8 M W E.SF E.OF V V setge Set byte if greater or equal (SF=OF). +REX+ 0F 9D /0 SETGE r/m8 M W E.SF E.OF V NE setge Set byte if greater or equal (SF=OF). +0F 9C /0 SETL r/m8 M W E.SF E.OF V V setl Set byte if less (SF!!= OF). +REX+ 0F 9C /0 SETL r/m8 M W E.SF E.OF V NE setl Set byte if less (SF!!= OF). +0F 9E /0 SETLE r/m8 M W E.ZF E.SF E.OF V V setle Set byte if less or equal (ZF=1 or SF!!= OF). +REX+ 0F 9E /0 SETLE r/m8 M W E.ZF E.SF E.OF V NE setle Set byte if less or equal (ZF=1 or SF!!= OF). +0F 96 /0 SETNA r/m8 M W E.CF E.ZF V V setna Set byte if not above (CF=1 or ZF=1). +REX+ 0F 96 /0 SETNA r/m8 M W E.CF E.ZF V NE setna Set byte if not above (CF=1 or ZF=1). +0F 92 /0 SETNAE r/m8 M W E.CF V V setnae Set byte if not above or equal (CF=1). +REX+ 0F 92 /0 SETNAE r/m8 M W E.CF V NE setnae Set byte if not above or equal (CF=1). +0F 93 /0 SETNB r/m8 M W E.CF V V setnb Set byte if not below (CF=0). +REX+ 0F 93 /0 SETNB r/m8 M W E.CF V NE setnb Set byte if not below (CF=0). +0F 97 /0 SETNBE r/m8 M W E.CF E.ZF V V setnbe Set byte if not below or equal (CF=0 and ZF=0). +REX+ 0F 97 /0 SETNBE r/m8 M W E.CF E.ZF V NE setnbe Set byte if not below or equal (CF=0 and ZF=0). +0F 93 /0 SETNC r/m8 M W E.CF V V setnc Set byte if not carry (CF=0). +REX+ 0F 93 /0 SETNC r/m8 M W E.CF V NE setnc Set byte if not carry (CF=0). +0F 95 /0 SETNE r/m8 M W E.ZF V V setne Set byte if not equal (ZF=0). +REX+ 0F 95 /0 SETNE r/m8 M W E.ZF V NE setne Set byte if not equal (ZF=0). +0F 9E /0 SETNG r/m8 M W E.ZF E.SF E.OF V V setng Set byte if not greater (ZF=1 or SF!!= OF) +REX+ 0F 9E /0 SETNG r/m8 M W E.ZF E.SF E.OF V NE setng Set byte if not greater (ZF=1 or SF!!= OF) +0F 9C /0 SETNGE r/m8 M W E.SF E.OF V V setnge Set byte if not greater or equal (SF!!= OF). +REX+ 0F 9C /0 SETNGE r/m8 M W E.SF E.OF V NE setnge Set byte if not greater or equal (SF!!= OF). +0F 9D /0 SETNL r/m8 M W E.SF E.OF V V setnl Set byte if not less (SF=OF). +REX+ 0F 9D /0 SETNL r/m8 M W E.SF E.OF V NE setnl Set byte if not less (SF=OF). +0F 9F /0 SETNLE r/m8 M W E.ZF E.SF E.OF V V setnle Set byte if not less or equal (ZF=0 and SF=OF). +REX+ 0F 9F /0 SETNLE r/m8 M W E.ZF E.SF E.OF V NE setnle Set byte if not less or equal (ZF=0 and SF=OF). +0F 91 /0 SETNO r/m8 M W E.OF V V setno Set byte if not overflow (OF=0). +REX+ 0F 91 /0 SETNO r/m8 M W E.OF V NE setno Set byte if not overflow (OF=0). +0F 9B /0 SETNP r/m8 M W E.PF V V setnp Set byte if not parity (PF=0). +REX+ 0F 9B /0 SETNP r/m8 M W E.PF V NE setnp Set byte if not parity (PF=0). +0F 99 /0 SETNS r/m8 M W E.SF V V setns Set byte if not sign (SF=0). +REX+ 0F 99 /0 SETNS r/m8 M W E.SF V NE setns Set byte if not sign (SF=0). +0F 95 /0 SETNZ r/m8 M W E.ZF V V setnz Set byte if not zero (ZF=0). +REX+ 0F 95 /0 SETNZ r/m8 M W E.ZF V NE setnz Set byte if not zero (ZF=0). +0F 90 /0 SETO r/m8 M W E.OF V V seto Set byte if overflow (OF=1) +REX+ 0F 90 /0 SETO r/m8 M W E.OF V NE seto Set byte if overflow (OF=1) +0F 9A /0 SETP r/m8 M W E.PF V V setp Set byte if parity (PF=1). +REX+ 0F 9A /0 SETP r/m8 M W E.PF V NE setp Set byte if parity (PF=1). +0F 9A /0 SETPE r/m8 M W E.PF V V setpe Set byte if parity even (PF=1). +REX+ 0F 9A /0 SETPE r/m8 M W E.PF V NE setpe Set byte if parity even (PF=1). +0F 9B /0 SETPO r/m8 M W E.PF V V setpo Set byte if parity odd (PF=0). +REX+ 0F 9B /0 SETPO r/m8 M W E.PF V NE setpo Set byte if parity odd (PF=0). +0F 98 /0 SETS r/m8 M W E.SF V V sets Set byte if sign (SF=1). +REX+ 0F 98 /0 SETS r/m8 M W E.SF V NE sets Set byte if sign (SF=1). +0F 94 /0 SETZ r/m8 M W E.ZF V V setz Set byte if zero (ZF=1). +REX+ 0F 94 /0 SETZ r/m8 M W E.ZF V NE setz Set byte if zero (ZF=1). + +0F AE F8 SFENCE NP V V sfence Serializes store operations. + +0F 01 /0 SGDT m NO NO V V Store GDTR to m. + +0F A4 SHLD r/m16, r16, imm8 MRI Rwu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V V shldw Shift r/m16 to left imm8 places while shifting bits from r16 in from the right. +0F A5 SHLD r/m16, r16, CL MRC Rwu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V V shldw Shift r/m16 to left CL places while shifting bits from r16 in from the right. +0F A4 SHLD r/m32, r32, imm8 MRI Rzu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V V shldl Shift r/m32 to left imm8 places while shifting bits from r32 in from the right. +REX.W+ 0F A4 SHLD r/m64, r64, imm8 MRI Rwu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V NE shldq Shift r/m64 to left imm8 places while shifting bits from r64 in from the right. +0F A5 SHLD r/m32, r32, CL MRC Rzu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V V shldl Shift r/m32 to left CL places while shifting bits from r32 in from the right. +REX.W+ 0F A5 SHLD r/m64, r64, CL MRC Rwu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V NE shldq Shift r/m64 to left CL places while shifting bits from r64 in from the right. + +0F AC SHRD r/m16, r16, imm8 MRI Rwu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V V shrdw Shift r/m16 to right imm8 places while shifting bits from r16 in from the left. +0F AD SHRD r/m16, r16, CL MRC Rwu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V V shrdw Shift r/m16 to right CL places while shifting bits from r16 in from the left. +0F AC SHRD r/m32, r32, imm8 MRI Rzu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V V shrdl Shift r/m32 to right imm8 places while shifting bits from r32 in from the left. +REX.W+ 0F AC SHRD r/m64, r64, imm8 MRI Rwu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V NE shrdq Shift r/m64 to right imm8 places while shifting bits from r64 in from the left. +0F AD SHRD r/m32, r32, CL MRC Rzu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V V shrdl Shift r/m32 to right CL places while shifting bits from r32 in from the left. +REX.W+ 0F AD SHRD r/m64, r64, CL MRC Rwu, R, R e.cf e.sf e.zf e.pf e.of e.sf e.zf e.af e.cf e.pf V NE shrdq Shift r/m64 to right CL places while shifting bits from r64 in from the left. + +66 0F C6 /r ib SHUFPD xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSE2 shufpd Shuffle packed double-precision floating- point values selected by imm8 from xmm1 and xmm2/m128 to xmm1. +VEX.NDS.128.66.0F.WIG C6 /r ib VSHUFPD xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vshufpd Shuffle Packed double-precision floating- point values selected by imm8 from xmm2 and xmm3/mem. +VEX.NDS.256.66.0F.WIG C6 /r ib VSHUFPD ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX vshufpd Shuffle Packed double-precision floating- point values selected by imm8 from ymm2 and ymm3/mem. + +0F C6 /r ib SHUFPS xmm1, xmm2/m128, imm8 RMI RW, R, R V V SSE shufps Shuffle packed single-precision floating-point values selected by imm8 from xmm1 and xmm1/m128 to xmm1. +VEX.NDS.128.0F.WIG C6 /r ib VSHUFPS xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX vshufps Shuffle Packed single-precision floating-point values selected by imm8 from xmm2 and xmm3/mem. +VEX.NDS.256.0F.WIG C6 /r ib VSHUFPS ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX vshufps Shuffle Packed single-precision floating-point values selected by imm8 from ymm2 and ymm3/mem. + +0F 01 /1 SIDT m NO NO V V Store IDTR to m. + +0F 00 /0 SLDT r/m16 NO NO V V Stores segment selector from LDTR in r/m16. +REX.W+ 0F 00 /0 SLDT r64/m16 NO NO V V Stores segment selector from LDTR in r64/m16. + +0F 01 /4 SMSW r/m16 NO* NO V V Store machine status word to r/m16. +0F 01 /4 SMSW r32/m16 NO* NO V V Store machine status word in low-order 16 bits of r32/m16; high-order 16 bits of r32 are undefined. +REX.W+ 0F 01 /4 SMSW r64/m16 NO* NO V V Store machine status word in low-order 16 bits of r64/m16; high-order 16 bits of r32 are undefined. + +66 0F 51 /r SQRTPD xmm1, xmm2/m128 RM W, R V V SSE2 sqrtpd Computes square roots of the packed double- precision floating-point values in xmm2/m128 and stores the results in xmm1. +VEX.128.66.0F.WIG 51 /r VSQRTPD xmm1, xmm2/m128 RM Z, R V V AVX vsqrtpd Computes Square Roots of the packed double- precision floating-point values in xmm2/m128 and stores the result in xmm1. +VEX.256.66.0F.WIG 51 /r VSQRTPD ymm1, ymm2/m256 RM W, R V V AVX vsqrtpd Computes Square Roots of the packed double- precision floating-point values in ymm2/m256 and stores the result in ymm1 + +0F 51 /r SQRTPS xmm1, xmm2/m128 RM W, R V V SSE sqrtps Computes square roots of the packed single- precision floating-point values in xmm2/m128 and stores the results in xmm1. +VEX.128.0F.WIG 51 /r VSQRTPS xmm1, xmm2/m128 RM Z, R V V AVX vsqrtps Computes Square Roots of the packed single- precision floating-point values in xmm2/m128 and stores the result in xmm1. +VEX.256.0F.WIG 51 /r VSQRTPS ymm1, ymm2/m256 RM W, R V V AVX vsqrtps Computes Square Roots of the packed single- precision floating-point values in ymm2/m256 and stores the result in ymm1. + +F2 0F 51 /r SQRTSD xmm1, xmm2/m64 RM RW, R V V SSE2 sqrtsd Computes square root of the low double- precision floating-point value in xmm2/m64 and stores the results in xmm1. +VEX.NDS.LIG.F2.0F.WIG 51 /r VSQRTSD xmm1,xmm2, xmm3/m64 RVM Z, R, R V V AVX vsqrtsd Computes square root of the low double- precision floating point value in xmm3/m64 and stores the results in xmm2. Also, upper double precision floating-point value (bits[127:64]) from xmm2 is copied to xmm1[127:64]. + +F3 0F 51 /r SQRTSS xmm1, xmm2/m32 RM RW, R V V SSE sqrtss Computes square root of the low single- precision floating-point value in xmm2/m32 and stores the results in xmm1. +VEX.NDS.LIG.F3.0F.WIG 51 VSQRTSS xmm1, xmm2, xmm3/m32 RVM Z, R, R V V AVX vsqrtss Computes square root of the low single- precision floating-point value in xmm3/m32 and stores the results in xmm1. Also, upper single precision floating-point values (bits[127:32]) from xmm2 are copied to xmm1[127:32]. + +F9 STC NP E.CF V V stc Set CF flag. + +FD STD NP E.DF V V std Set DF flag. + +FB STI NP E.VM E.IOPL E.VIP e.if e.vif V V sti Set interrupt flag; external, maskable interrupts enabled at the end of the next instruction. + +0F AE /3 STMXCSR m32 M W M.* V V SSE stmxcsr Store contents of MXCSR register to m32. +VEX.LZ.0F.WIG AE /3 VSTMXCSR m32 M W M.* V V AVX vstmxcsr Store contents of MXCSR register to m32. + +AA STOS m8 NP I E.DF RDI AL V V stosb For legacy mode, store AL at address ES:(E)DI; For 64-bit mode store AL at address RDI or EDI. +AB STOS m16 NP I E.DF RDI AX V V stosw For legacy mode, store AX at address ES:(E)DI; For 64-bit mode store AX at address RDI or EDI. +AB STOS m32 NP I E.DF RDI EAX V V stosl For legacy mode, store EAX at address ES:(E)DI; For 64-bit mode store EAX at address RDI or EDI. +REX.W+ AB STOS m64 NP I E.DF RDI RAX V NE stosq Store RAX at address RDI or EDI. +AA STOSB NP E.DF RDI AL V V stosb For legacy mode, store AL at address ES:(E)DI; For 64-bit mode store AL at address RDI or EDI. +PREF.66+ AB STOSW NP E.DF RDI AX V V stosw For legacy mode, store AX at address ES:(E)DI; For 64-bit mode store AX at address RDI or EDI. +AB STOSD NP E.DF RDI EAX V V stosl For legacy mode, store EAX at address ES:(E)DI; For 64-bit mode store EAX at address RDI or EDI. +REX.W+ AB STOSQ NP E.DF RDI RAX V NE stosq Store RAX at address RDI or EDI. + +0F 00 /1 STR r/m16 NO NO V V Stores segment selector from TR in r/m16. + +2C ib SUB AL, imm8 I RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subb Subtract imm8 from AL. +2D iw SUB AX, imm16 I RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subw Subtract imm16 from AX. +2D id SUB EAX, imm32 I RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subl Subtract imm32 from EAX. +REX.W+ 2D id SUB RAX, imm32 I RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE subq Subtract imm32 sign-extended to 64-bits from RAX. +80 /5 ib SUB r/m8, imm8 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subb Subtract imm8 from r/m8. +REX+ 80 /5 ib SUB r/m8, imm8 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE subb Subtract imm8 from r/m8. +81 /5 iw SUB r/m16, imm16 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subw Subtract imm16 from r/m16. +81 /5 id SUB r/m32, imm32 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subl Subtract imm32 from r/m32. +REX.W+ 81 /5 id SUB r/m64, imm32 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE subq Subtract imm32 sign-extended to 64-bits from r/m64. +83 /5 ib SUB r/m16, imm8 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subw YES Subtract sign-extended imm8 from r/m16. +83 /5 ib SUB r/m32, imm8 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subl YES Subtract sign-extended imm8 from r/m32. +REX.W+ 83 /5 ib SUB r/m64, imm8 MI RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE subq YES Subtract sign-extended imm8 from r/m64. +28 /r SUB r/m8, r8 MR RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subb YES Subtract r8 from r/m8. +REX+ 28 /r SUB r/m8, r8 MR RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE subb YES Subtract r8 from r/m8. +29 /r SUB r/m16, r16 MR RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subw YES Subtract r16 from r/m16. +29 /r SUB r/m32, r32 MR RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subl YES Subtract r32 from r/m32. +REX.W+ 29 /r SUB r/m64, r64 MR RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE subq YES Subtract r64 from r/m64. +2A /r SUB r8, r/m8 RM RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subb Subtract r/m8 from r8. +REX+ 2A /r SUB r8, r/m8 RM RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE subb Subtract r/m8 from r8. +2B /r SUB r16, r/m16 RM RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subw Subtract r/m16 from r16. +2B /r SUB r32, r/m32 RM RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V V subl Subtract r/m32 from r32. +REX.W+ 2B /r SUB r64, r/m64 RM RW, R E.OF E.SF E.ZF E.AF E.CF E.PF V NE subq Subtract r/m64 from r64. + +66 0F 5C /r SUBPD xmm1, xmm2/m128 RM RW, R V V SSE2 subpd Subtract packed double-precision floating- point values in xmm2/m128 from xmm1. +VEX.NDS.128.66.0F.WIG 5C /r VSUBPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vsubpd Subtract packed double-precision floating- point values in xmm3/mem from xmm2 and stores result in xmm1. +VEX.NDS.256.66.0F.WIG 5C /r VSUBPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vsubpd Subtract packed double-precision floating- point values in ymm3/mem from ymm2 and stores result in ymm1. + +0F 5C /r SUBPS xmm1, xmm2/m128 RM RW, R V V SSE subps Subtract packed single-precision floating-point values in xmm2/mem from xmm1. +VEX.NDS.128.0F.WIG 5C /r VSUBPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vsubps Subtract packed single-precision floating-point values in xmm3/mem from xmm2 and stores result in xmm1. +VEX.NDS.256.0F.WIG 5C /r VSUBPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vsubps Subtract packed single-precision floating-point values in ymm3/mem from ymm2 and stores result in ymm1. + +F2 0F 5C /r SUBSD xmm1, xmm2/m64 RM RW, R V V SSE2 subsd Subtracts the low double-precision floating- point values in xmm2/mem64 from xmm1. +VEX.NDS.LIG.F2.0F.WIG 5C /r VSUBSD xmm1, xmm2, xmm3/m64 RVM Z, R, R V V AVX vsubsd Subtract the low double-precision floating- point value in xmm3/mem from xmm2 and store the result in xmm1. + +F3 0F 5C /r SUBSS xmm1, xmm2/m32 RM RW, R V V SSE subss Subtract the lower single-precision floating- point values in xmm2/m32 from xmm1. +VEX.NDS.LIG.F3.0F.WIG 5C /r VSUBSS xmm1, xmm2, xmm3/m32 RVM Z, R, R V V AVX vsubss Subtract the low single-precision floating- point value in xmm3/mem from xmm2 and store the result in xmm1. + +0F 01 F8 SWAPGS NP V I swapgs Exchanges the current GS base register value with the value contained in MSR address C0000102H. + +0F 05 SYSCALL NP ??? ??? ??? V I SYSCALL syscall Fast call to privilege level 0 system procedures. + +0F 34 SYSENTER NP ??? ??? ??? V V SEP sysenter Fast call to privilege level 0 system procedures. + +0F 35 SYSEXIT NP ??? ??? ??? V V SEP sysexit Fast return to privilege level 3 user code. +REX.W+ 0F 35 SYSEXIT pw NP I ??? ??? ??? V V SEP sysexit Fast return to 64-bit mode privilege level 3 user code. + +0F 07 SYSRET NP ??? ??? ??? V I SYSCALL sysret Return to compatibility mode from fast system call +REX.W+ 0F 07 SYSRET pw NP I V I SYSCALL sysret Return to 64-bit mode from fast system call + +A8 ib TEST AL, imm8 I R, R E.OF E.SF E.ZF E.CF E.PF E.AF V V testb AND imm8 with AL; set SF, ZF, PF according to result. +A9 iw TEST AX, imm16 I R, R E.OF E.SF E.ZF E.CF E.PF E.AF V V testw AND imm16 with AX; set SF, ZF, PF according to result. +A9 id TEST EAX, imm32 I R, R E.OF E.SF E.ZF E.CF E.PF E.AF V V testl AND imm32 with EAX; set SF, ZF, PF according to result. +REX.W+ A9 id TEST RAX, imm32 I R, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE testq AND imm32 sign-extended to 64-bits with RAX; set SF, ZF, PF according to result. +F6 /0 ib TEST r/m8, imm8 MI R, R E.OF E.SF E.ZF E.CF E.PF E.AF V V testb AND imm8 with r/m8; set SF, ZF, PF according to result. +REX+ F6 /0 ib TEST r/m8, imm8 MI R, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE testb AND imm8 with r/m8; set SF, ZF, PF according to result. +F7 /0 iw TEST r/m16, imm16 MI R, R E.OF E.SF E.ZF E.CF E.PF E.AF V V testw AND imm16 with r/m16; set SF, ZF, PF according to result. +F7 /0 id TEST r/m32, imm32 MI R, R E.OF E.SF E.ZF E.CF E.PF E.AF V V testl AND imm32 with r/m32; set SF, ZF, PF according to result. +REX.W+ F7 /0 id TEST r/m64, imm32 MI R, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE testq AND imm32 sign-extended to 64-bits with r/m64; set SF, ZF, PF according to result. +84 /r TEST r/m8, r8 MR R, R E.OF E.SF E.ZF E.CF E.PF E.AF V V testb AND r8 with r/m8; set SF, ZF, PF according to result. +REX+ 84 /r TEST r/m8, r8 MR R, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE testb AND r8 with r/m8; set SF, ZF, PF according to result. +85 /r TEST r/m16, r16 MR R, R E.OF E.SF E.ZF E.CF E.PF E.AF V V testw AND r16 with r/m16; set SF, ZF, PF according to result. +85 /r TEST r/m32, r32 MR R, R E.OF E.SF E.ZF E.CF E.PF E.AF V V testl AND r32 with r/m32; set SF, ZF, PF according to result. +REX.W+ 85 /r TEST r/m64, r64 MR R, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE testq AND r64 with r/m64; set SF, ZF, PF according to result. + +F3 0F BC /r TZCNT r16, r/m16 RM W, R E.ZF E.CF E.AF E.PF E.OF E.SF V V BMI1 tzcntw Count the number of trailing zero bits in r/m16, return result in r16. +F3 0F BC /r TZCNT r32, r/m32 RM W, R E.ZF E.CF E.AF E.PF E.OF E.SF V V BMI1 tzcntl Count the number of trailing zero bits in r/m32, return result in r32. +REX.W+ F3 0F BC /r TZCNT r64, r/m64 RM W, R E.ZF E.CF E.AF E.PF E.OF E.SF V NE BMI1 tzcntq Count the number of trailing zero bits in r/m64, return result in r64. + +66 0F 2E /r UCOMISD xmm1, xmm2/m64 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V SSE2 ucomisd Compares (unordered) the low double- precision floating-point values in xmm1 and xmm2/m64 and set the EFLAGS accordingly. +VEX.LIG.66.0F.WIG 2E /r VUCOMISD xmm1, xmm2/m64 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V AVX vucomisd Compare low double precision floating-point values in xmm1 and xmm2/mem64 and set the EFLAGS flags accordingly. + +0F 2E /r UCOMISS xmm1, xmm2/m32 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V SSE ucomiss Compare lower single-precision floating-point value in xmm1 register with lower single- precision floating-point value in xmm2/mem and set the status flags accordingly. +VEX.LIG.0F.WIG 2E /r VUCOMISS xmm1, xmm2/m32 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V AVX vucomiss Compare low single precision floating-point values in xmm1 and xmm2/mem32 and set the EFLAGS flags accordingly. + +0F 0B UD2 NP V V ud2 Raise invalid opcode exception. + +66 0F 15 /r UNPCKHPD xmm1, xmm2/m128 RM RW, R V V SSE2 unpckhpd Unpacks and Interleaves double-precision floating-point values from high quadwords of xmm1 and xmm2/m128. +VEX.NDS.128.66.0F.WIG 15 /r VUNPCKHPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vunpckhpd Unpacks and Interleaves double precision floating-point values from high quadwords of xmm2 and xmm3/m128. +VEX.NDS.256.66.0F.WIG 15 /r VUNPCKHPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vunpckhpd Unpacks and Interleaves double precision floating-point values from high quadwords of ymm2 and ymm3/m256. + +0F 15 /r UNPCKHPS xmm1, xmm2/m128 RM RW, R V V SSE unpckhps Unpacks and Interleaves single-precision floating-point values from high quadwords of xmm1 and xmm2/mem into xmm1. +VEX.NDS.128.0F.WIG 15 /r VUNPCKHPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vunpckhps Unpacks and Interleaves single-precision floating-point values from high quadwords of xmm2 and xmm3/m128. +VEX.NDS.256.0F.WIG 15 /r VUNPCKHPS ymm1, ymm2,ymm3/m256 RVM W, R, R V V AVX vunpckhps Unpacks and Interleaves single-precision floating-point values from high quadwords of ymm2 and ymm3/m256. + +66 0F 14 /r UNPCKLPD xmm1, xmm2/m128 RM RW, R V V SSE2 unpcklpd Unpacks and Interleaves double-precision floating-point values from low quadwords of xmm1 and xmm2/m128. +VEX.NDS.128.66.0F.WIG 14 /r VUNPCKLPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vunpcklpd Unpacks and Interleaves double precision floating-point values low high quadwords of xmm2 and xmm3/m128. +VEX.NDS.256.66.0F.WIG 14 /r VUNPCKLPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vunpcklpd Unpacks and Interleaves double precision floating-point values low high quadwords of ymm2 and ymm3/m256. + +0F 14 /r UNPCKLPS xmm1, xmm2/m128 RM RW, R V V SSE unpcklps Unpacks and Interleaves single-precision floating-point values from low quadwords of xmm1 and xmm2/mem into xmm1. +VEX.NDS.128.0F.WIG 14 /r VUNPCKLPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vunpcklps Unpacks and Interleaves single-precision floating-point values from low quadwords of xmm2 and xmm3/m128. +VEX.NDS.256.0F.WIG 14 /r VUNPCKLPS ymm1, ymm2,ymm3/m256 RVM W, R, R V V AVX vunpcklps Unpacks and Interleaves single-precision floating-point values from low quadwords of ymm2 and ymm3/m256. + +VEX.128.66.0F38.W0 18 /r VBROADCASTSS xmm1, m32 RM Z, R V V AVX vbroadcastss Broadcast single-precision floating-point element in mem to four locations in xmm1. +VEX.256.66.0F38.W0 18 /r VBROADCASTSS ymm1, m32 RM W, R V V AVX vbroadcastss Broadcast single-precision floating-point element in mem to eight locations in ymm1. +VEX.256.66.0F38.W0 19 /r VBROADCASTSD ymm1, m64 RM W, R V V AVX vbroadcastsd Broadcast double-precision floating-point element in mem to four locations in ymm1. +VEX.256.66.0F38.W0 1A /r VBROADCASTF128 ymm1, m128 RM W, R V V AVX vbroadcastf128 Broadcast 128 bits of floating-point data in mem to low and high 128-bits in ymm1. +VEX.128.66.0F38.W0 18 /r VBROADCASTSS xmm1, xmm2 RM Z, R V V AVX2 vbroadcastss Broadcast the low single-precision floating- point element in the source operand to four locations in xmm1. +VEX.256.66.0F38.W0 18 /r VBROADCASTSS ymm1, xmm2 RM W, R V V AVX2 vbroadcastss Broadcast low single-precision floating-point element in the source operand to eight locations in ymm1. +VEX.256.66.0F38.W0 19 /r VBROADCASTSD ymm1, xmm2 RM W, R V V AVX2 vbroadcastsd Broadcast low double-precision floating-point element in the source operand to four locations in ymm1. + +VEX.256.66.0F38.W0 13 /r VCVTPH2PS ymm1, xmm2/m128 RM W, R M.RC V V F16C vcvtph2ps Convert eight packed half precision (16-bit) floating-point values in xmm2/m128 to packed single-precision floating-point value in ymm1. +VEX.128.66.0F38.W0 13 /r VCVTPH2PS xmm1, xmm2/m64 RM Z, R M.RC V V F16C vcvtph2ps Convert four packed half precision (16-bit) floating-point values in xmm2/m64 to packed single-precision floating-point value in xmm1. + +VEX.256.66.0F3A.W0 1D /r ib VCVTPS2PH xmm1/m128, ymm2, imm8 MR Z, R, R M.RC V V F16C vcvtps2ph Convert eight packed single-precision floating-point value in ymm2 to packed half-precision (16-bit) floating-point value in xmm1/mem. Imm8 provides rounding controls. +VEX.128.66.0F3A.W0 1D /r ib VCVTPS2PH xmm1/m64, xmm2, imm8 MR Z, R, R M.RC V V F16C vcvtps2ph Convert four packed single-precision float- ing-point value in xmm2 to packed half- precision (16-bit) floating-point value in xmm1/mem. Imm8 provides rounding con- trols. + +0F 00 /4 VERR r/m16 M R E.ZF YES NO V V verr Set ZF=1 if segment specified with r/m16 can be read. +0F 00 /5 VERW r/m16 M R E.ZF YES NO V V verw Set ZF=1 if segment specified with r/m16 can be written. + +VEX.256.66.0F3A.W0 19 /r ib VEXTRACTF128 xmm1/m128, ymm2, imm8 MR QZ, R, R V V AVX vextractf128 Extract 128 bits of packed floating-point values from ymm2 and store results in xmm1/mem. + +VEX.256.66.0F3A.W0 39 /r ib VEXTRACTI128 xmm1/m128, ymm2, imm8 MRI RZ, R, R V V AVX2 vextracti128 Extract 128 bits of integer data from ymm2 and store results in xmm1/mem. + +VEX.DDS.128.66.0F38.W1 98 /r VFMADD132PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmadd132pd Multiply packed double-precision floating-point values from xmm0 and xmm2/mem, add to xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W1 A8 /r VFMADD213PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmadd213pd Multiply packed double-precision floating-point values from xmm0 and xmm1, add to xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W1 B8 /r VFMADD231PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmadd231pd Multiply packed double-precision floating-point values from xmm1 and xmm2/mem, add to xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W1 98 /r VFMADD132PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmadd132pd Multiply packed double-precision floating-point values from ymm0 and ymm2/mem, add to ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W1 A8 /r VFMADD213PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmadd213pd Multiply packed double-precision floating-point values from ymm0 and ymm1, add to ymm2/mem and put result in ymm0. +VEX.DDS.256.66.0F38.W1 B8 /r VFMADD231PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmadd231pd Multiply packed double-precision floating-point values from ymm1 and ymm2/mem, add to ymm0 and put result in ymm0. + +VEX.DDS.128.66.0F38.W0 98 /r VFMADD132PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmadd132ps Multiply packed single-precision floating-point values from xmm0 and xmm2/mem, add to xmm1 and put result in xmm0 +VEX.DDS.128.66.0F38.W0 A8 /r VFMADD213PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmadd213ps Multiply packed single-precision floating-point values from xmm0 and xmm1, add to xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W0 B8 /r VFMADD231PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmadd231ps Multiply packed single-precision floating-point values from xmm1 and xmm2/mem, add to xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W0 98 /r VFMADD132PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmadd132ps Multiply packed single-precision floating-point values from ymm0 and ymm2/mem, add to ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W0 A8 /r VFMADD213PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmadd213ps Multiply packed single-precision floating-point values from ymm0 and ymm1, add to ymm2/mem and put result in ymm0. +VEX.DDS.256.66.0F38.W0 B8 /r VFMADD231PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmadd231ps Multiply packed single-precision floating-point values from ymm1 and ymm2/mem, add to ymm0 and put result in ymm0. + +VEX.DDS.LIG.128.66.0F38.W1 99 /r VFMADD132SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfmadd132sd Multiply scalar double-precision floating-point value from xmm0 and xmm2/mem, add to xmm1 and put result in xmm0 +VEX.DDS.LIG.128.66.0F38.W1 A9 /r VFMADD213SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfmadd213sd Multiply scalar double-precision floating-point value from xmm0 and xmm1, add to xmm2/mem and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W1 B9 /r VFMADD231SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfmadd231sd Multiply scalar double-precision floating-point value from xmm1 and xmm2/mem, add to xmm0 and put result in xmm0. + +VEX.DDS.LIG.128.66.0F38.W0 99 /r VFMADD132SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfmadd132ss Multiply scalar single-precision floating-point value from xmm0 and xmm2/mem, add to xmm1 and put result in xmm0 +VEX.DDS.LIG.128.66.0F38.W0 A9 /r VFMADD213SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfmadd213ss Multiply scalar single-precision floating-point value from xmm0 and xmm1, add to xmm2/mem and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W0 B9 /r VFMADD231SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfmadd231ss Multiply scalar single-precision floating-point value from xmm1 and xmm2/mem, add to xmm0 and put result in xmm0. + +VEX.DDS.128.66.0F38.W1 96 /r VFMADDSUB132PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmaddsub132pd Multiply packed double-precision floating-point values from xmm0 and xmm2/mem, add/subtract elements in xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W1 A6 /r VFMADDSUB213PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmaddsub213pd Multiply packed double-precision floating-point values from xmm0 and xmm1, add/subtract elements in xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W1 B6 /r VFMADDSUB231PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmaddsub231pd Multiply packed double-precision floating-point values from xmm1 and xmm2/mem, add/subtract elements in xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W1 96 /r VFMADDSUB132PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmaddsub132pd Multiply packed double-precision floating-point values from ymm0 and ymm2/mem, add/subtract elements in ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W1 A6 /r VFMADDSUB213PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmaddsub213pd Multiply packed double-precision floating-point values from ymm0 and ymm1, add/subtract elements in ymm2/mem and put result in ymm0. +VEX.DDS.256.66.0F38.W1 B6 /r VFMADDSUB231PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmaddsub231pd Multiply packed double-precision floating-point values from ymm1 and ymm2/mem, add/subtract elements in ymm0 and put result in ymm0. + +VEX.DDS.128.66.0F38.W0 96 /r VFMADDSUB132PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmaddsub132ps Multiply packed single-precision floating-point values from xmm0 and xmm2/mem, add/subtract elements in xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W0 A6 /r VFMADDSUB213PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmaddsub213ps Multiply packed single-precision floating-point values from xmm0 and xmm1, add/subtract elements in xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W0 B6 /r VFMADDSUB231PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmaddsub231ps Multiply packed single-precision floating-point values from xmm1 and xmm2/mem, add/subtract elements in xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W0 96 /r VFMADDSUB132PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmaddsub132ps Multiply packed single-precision floating-point values from ymm0 and ymm2/mem, add/subtract elements in ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W0 A6 /r VFMADDSUB213PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmaddsub213ps Multiply packed single-precision floating-point values from ymm0 and ymm1, add/subtract elements in ymm2/mem and put result in ymm0. +VEX.DDS.256.66.0F38.W0 B6 /r VFMADDSUB231PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmaddsub231ps Multiply packed single-precision floating-point values from ymm1 and ymm2/mem, add/subtract elements in ymm0 and put result in ymm0. + +VEX.DDS.128.66.0F38.W1 97 /r VFMSUBADD132PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsubadd132pd Multiply packed double-precision floating-point values from xmm0 and xmm2/mem, subtract/add elements in xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W1 A7 /r VFMSUBADD213PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsubadd213pd Multiply packed double-precision floating-point values from xmm0 and xmm1, subtract/add elements in xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W1 B7 /r VFMSUBADD231PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsubadd231pd Multiply packed double-precision floating-point values from xmm1 and xmm2/mem, subtract/add elements in xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W1 97 /r VFMSUBADD132PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsubadd132pd Multiply packed double-precision floating-point values from ymm0 and ymm2/mem, subtract/add elements in ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W1 A7 /r VFMSUBADD213PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsubadd213pd Multiply packed double-precision floating-point values from ymm0 and ymm1, subtract/add elements in ymm2/mem and put result in ymm0. +VEX.DDS.256.66.0F38.W1 B7 /r VFMSUBADD231PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsubadd231pd Multiply packed double-precision floating-point values from ymm1 and ymm2/mem, subtract/add elements in ymm0 and put result in ymm0. + +VEX.DDS.128.66.0F38.W0 97 /r VFMSUBADD132PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsubadd132ps Multiply packed single-precision floating-point values from xmm0 and xmm2/mem, subtract/add elements in xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W0 A7 /r VFMSUBADD213PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsubadd213ps Multiply packed single-precision floating-point values from xmm0 and xmm1, subtract/add elements in xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W0 B7 /r VFMSUBADD231PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsubadd231ps Multiply packed single-precision floating-point values from xmm1 and xmm2/mem, subtract/add elements in xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W0 97 /r VFMSUBADD132PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsubadd132ps Multiply packed single-precision floating-point values from ymm0 and ymm2/mem, subtract/add elements in ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W0 A7 /r VFMSUBADD213PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsubadd213ps Multiply packed single-precision floating-point values from ymm0 and ymm1, subtract/add elements in ymm2/mem and put result in ymm0. +VEX.DDS.256.66.0F38.W0 B7 /r VFMSUBADD231PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsubadd231ps Multiply packed single-precision floating-point values from ymm1 and ymm2/mem, subtract/add elements in ymm0 and put result in ymm0. + +VEX.DDS.128.66.0F38.W1 9A /r VFMSUB132PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsub132pd Multiply packed double-precision floating-point values from xmm0 and xmm2/mem, subtract xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W1 AA /r VFMSUB213PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsub213pd Multiply packed double-precision floating-point values from xmm0 and xmm1, subtract xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W1 BA /r VFMSUB231PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsub231pd Multiply packed double-precision floating-point values from xmm1 and xmm2/mem, subtract xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W1 9A /r VFMSUB132PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsub132pd Multiply packed double-precision floating-point values from ymm0 and ymm2/mem, subtract ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W1 AA /r VFMSUB213PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsub213pd Multiply packed double-precision floating-point values from ymm0 and ymm1, subtract ymm2/mem and put result in ymm0 +VEX.DDS.256.66.0F38.W1 BA /r VFMSUB231PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsub231pd Multiply packed double-precision floating-point values from ymm1 and ymm2/mem, subtract ymm0 and put result in ymm0. + +VEX.DDS.128.66.0F38.W0 9A /r VFMSUB132PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsub132ps Multiply packed single-precision floating-point values from xmm0 and xmm2/mem, subtract xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W0 AA /r VFMSUB213PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsub213ps Multiply packed single-precision floating-point values from xmm0 and xmm1, subtract xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W0 BA /r VFMSUB231PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfmsub231ps Multiply packed single-precision floating-point values from xmm1 and xmm2/mem, subtract xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W0 9A /r VFMSUB132PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsub132ps Multiply packed single-precision floating-point values from ymm0 and ymm2/mem, subtract ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W0 AA /r VFMSUB213PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsub213ps Multiply packed single-precision floating-point values from ymm0 and ymm1, subtract ymm2/mem and put result in ymm0 +VEX.DDS.256.66.0F38.W0 BA /r VFMSUB231PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfmsub231ps Multiply packed single-precision floating-point values from ymm1 and ymm2/mem, subtract ymm0 and put result in ymm0. + +VEX.DDS.LIG.128.66.0F38.W1 9B /r VFMSUB132SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfmsub132sd Multiply scalar double-precision floating-point value from xmm0 and xmm2/mem, subtract xmm1 and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W1 AB /r VFMSUB213SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfmsub213sd Multiply scalar double-precision floating-point value from xmm0 and xmm1, subtract xmm2/mem and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W1 BB /r VFMSUB231SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfmsub231sd Multiply scalar double-precision floating-point value from xmm1 and xmm2/mem, subtract xmm0 and put result in xmm0. + +VEX.DDS.LIG.128.66.0F38.W0 9B /r VFMSUB132SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfmsub132ss Multiply scalar single-precision floating-point value from xmm0 and xmm2/mem, subtract xmm1 and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W0 AB /r VFMSUB213SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfmsub213ss Multiply scalar single-precision floating-point value from xmm0 and xmm1, subtract xmm2/mem and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W0 BB /r VFMSUB231SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfmsub231ss Multiply scalar single-precision floating-point value from xmm1 and xmm2/mem, subtract xmm0 and put result in xmm0. + +VEX.DDS.128.66.0F38.W1 9C /r VFNMADD132PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmadd132pd Multiply packed double-precision floating-point values from xmm0 and xmm2/mem, negate the multiplication result and add to xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W1 AC /r VFNMADD213PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmadd213pd Multiply packed double-precision floating-point values from xmm0 and xmm1, negate the multiplication result and add to xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W1 BC /r VFNMADD231PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmadd231pd Multiply packed double-precision floating-point values from xmm1 and xmm2/mem, negate the multiplication result and add to xmm0 and put result in xmm0 +VEX.DDS.256.66.0F38.W1 9C /r VFNMADD132PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmadd132pd Multiply packed double-precision floating-point values from ymm0 and ymm2/mem, negate the multiplication result and add to ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W1 AC /r VFNMADD213PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmadd213pd Multiply packed double-precision floating-point values from ymm0 and ymm1, negate the multiplication result and add to ymm2/mem and put result in ymm0 +VEX.DDS.256.66.0F38.W1 BC /r VFNMADD231PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmadd231pd Multiply packed double-precision floating-point values from ymm1 and ymm2/mem, negate the multiplication result and add to ymm0 and put result in ymm0. + +VEX.DDS.128.66.0F38.W0 9C /r VFNMADD132PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmadd132ps Multiply packed single-precision floating-point values from xmm0 and xmm2/mem, negate the multiplication result and add to xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W0 AC /r VFNMADD213PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmadd213ps Multiply packed single-precision floating-point values from xmm0 and xmm1, negate the multiplication result and add to xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W0 BC /r VFNMADD231PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmadd231ps Multiply packed single-precision floating-point values from xmm1 and xmm2/mem, negate the multiplication result and add to xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W0 9C /r VFNMADD132PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmadd132ps Multiply packed single-precision floating-point values from ymm0 and ymm2/mem, negate the multiplication result and add to ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W0 AC /r VFNMADD213PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmadd213ps Multiply packed single-precision floating-point values from ymm0 and ymm1, negate the multiplication result and add to ymm2/mem and put result in ymm0. +VEX.DDS.256.66.0F38.0 BC /r VFNMADD231PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmadd231ps Multiply packed single-precision floating-point values from ymm1 and ymm2/mem, negate the multiplication result and add to ymm0 and put result in ymm0. + +VEX.DDS.LIG.128.66.0F38.W1 9D /r VFNMADD132SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfnmadd132sd Multiply scalar double-precision floating-point value from xmm0 and xmm2/mem, negate the multiplication result and add to xmm1 and put result in xmm0 +VEX.DDS.LIG.128.66.0F38.W1 AD /r VFNMADD213SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfnmadd213sd Multiply scalar double-precision floating-point value from xmm0 and xmm1, negate the multiplication result and add to xmm2/mem and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W1 BD /r VFNMADD231SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfnmadd231sd Multiply scalar double-precision floating-point value from xmm1 and xmm2/mem, negate the multiplication result and add to xmm0 and put result in xmm0. + +VEX.DDS.LIG.128.66.0F38.W0 9D /r VFNMADD132SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfnmadd132ss Multiply scalar single-precision floating-point value from xmm0 and xmm2/mem, negate the multiplication result and add to xmm1 and put result in xmm0 +VEX.DDS.LIG.128.66.0F38.W0 AD /r VFNMADD213SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfnmadd213ss Multiply scalar single-precision floating-point value from xmm0 and xmm1, negate the multiplication result and add to xmm2/mem and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W0 BD /r VFNMADD231SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfnmadd231ss Multiply scalar single-precision floating-point value from xmm1 and xmm2/mem, negate the multiplication result and add to xmm0 and put result in xmm0. + +VEX.DDS.128.66.0F38.W1 9E /r VFNMSUB132PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmsub132pd Multiply packed double-precision floating-point values from xmm0 and xmm2/mem, negate the multiplication result and subtract xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W1 AE /r VFNMSUB213PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmsub213pd Multiply packed double-precision floating-point values from xmm0 and xmm1, negate the multiplication result and subtract xmm2/mem and put result in xmm0 +VEX.DDS.128.66.0F38.W1 BE /r VFNMSUB231PD xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmsub231pd Multiply packed double-precision floating-point values from xmm1 and xmm2/mem, negate the multiplication result and subtract xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W1 9E /r VFNMSUB132PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmsub132pd Multiply packed double-precision floating-point values from ymm0 and ymm2/mem, negate the multiplication result and subtract ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W1 AE /r VFNMSUB213PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmsub213pd Multiply packed double-precision floating-point values from ymm0 and ymm1, negate the multiplication result and subtract ymm2/mem and put result in ymm0. +VEX.DDS.256.66.0F38.W1 BE /r VFNMSUB231PD ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmsub231pd Multiply packed double-precision floating-point values from ymm1 and ymm2/mem, negate the multiplication result and subtract ymm0 and put result in ymm0. + +VEX.DDS.128.66.0F38.W0 9E /r VFNMSUB132PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmsub132ps Multiply packed single-precision floating-point values from xmm0 and xmm2/mem, negate the multiplication result and subtract xmm1 and put result in xmm0. +VEX.DDS.128.66.0F38.W0 AE /r VFNMSUB213PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmsub213ps Multiply packed single-precision floating-point values from xmm0 and xmm1, negate the multiplication result and subtract xmm2/mem and put result in xmm0. +VEX.DDS.128.66.0F38.W0 BE /r VFNMSUB231PS xmm0, xmm1, xmm2/m128 RVM RZ, R, R V V FMA vfnmsub231ps Multiply packed single-precision floating-point values from xmm1 and xmm2/mem, negate the multiplication result and subtract xmm0 and put result in xmm0. +VEX.DDS.256.66.0F38.W0 9E /r VFNMSUB132PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmsub132ps Multiply packed single-precision floating-point values from ymm0 and ymm2/mem, negate the multiplication result and subtract ymm1 and put result in ymm0. +VEX.DDS.256.66.0F38.W0 AE /r VFNMSUB213PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmsub213ps Multiply packed single-precision floating-point values from ymm0 and ymm1, negate the multiplication result and subtract ymm2/mem and put result in ymm0. +VEX.DDS.256.66.0F38.0 BE /r VFNMSUB231PS ymm0, ymm1, ymm2/m256 RVM RW, R, R V V FMA vfnmsub231ps Multiply packed single-precision floating-point values from ymm1 and ymm2/mem, negate the multiplication result and subtract ymm0 and put result in ymm0. + +VEX.DDS.LIG.128.66.0F38.W1 9F /r VFNMSUB132SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfnmsub132sd Multiply scalar double-precision floating-point value from xmm0 and xmm2/mem, negate the multiplication result and subtract xmm1 and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W1 AF /r VFNMSUB213SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfnmsub213sd Multiply scalar double-precision floating-point value from xmm0 and xmm1, negate the multiplication result and subtract xmm2/mem and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W1 BF /r VFNMSUB231SD xmm0, xmm1, xmm2/m64 RVM RZ, R, R V V FMA vfnmsub231sd Multiply scalar double-precision floating-point value from xmm1 and xmm2/mem, negate the multiplication result and subtract xmm0 and put result in xmm0. + +VEX.DDS.LIG.128.66.0F38.W0 9F /r VFNMSUB132SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfnmsub132ss Multiply scalar single-precision floating-point value from xmm0 and xmm2/mem, negate the multiplication result and subtract xmm1 and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W0 AF /r VFNMSUB213SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfnmsub213ss Multiply scalar single-precision floating-point value from xmm0 and xmm1, negate the multiplication result and subtract xmm2/mem and put result in xmm0. +VEX.DDS.LIG.128.66.0F38.W0 BF /r VFNMSUB231SS xmm0, xmm1, xmm2/m32 RVM RZ, R, R V V FMA vfnmsub231ss Multiply scalar single-precision floating-point value from xmm1 and xmm2/mem, negate the multiplication result and subtract xmm0 and put result in xmm0. + +VEX.DDS.128.66.0F38.W1 92 /r VGATHERDPD xmm1, vm32x, xmm2 RMV Z, R, R V V AVX2 vgatherdpd Using dword indices specified in vm32x, gather double-precision FP values from memory conditioned on mask specified by xmm2. Conditionally gathered elements are merged into xmm1. +VEX.DDS.128.66.0F38.W1 93 /r VGATHERQPD xmm1, vm64x, xmm2 RMV Z, R, R V V AVX2 vgatherqpd Using qword indices specified in vm64x, gather double-precision FP values from memory conditioned on mask specified by xmm2. Conditionally gathered elements are merged into xmm1. +VEX.DDS.256.66.0F38.W1 92 /r VGATHERDPD ymm1, vm32x, ymm2 RMV W, R, R V V AVX2 vgatherdpd Using dword indices specified in vm32x, gather double-precision FP values from memory conditioned on mask specified by ymm2. Conditionally gathered elements are merged into ymm1. +VEX.DDS.256.66.0F38.W1 93 /r VGATHERQPD ymm1, vm64y, ymm2 RMV W, R, R V V AVX2 vgatherqpd Using qword indices specified in vm64y, gather double-precision FP values from memory conditioned on mask specified by ymm2. Conditionally gathered elements are merged into ymm1. + +VEX.DDS.128.66.0F38.W0 92 /r VGATHERDPS xmm1, vm32x, xmm2 RMV Z, R, R V V AVX2 vgatherdps Using dword indices specified in vm32x, gather single-precision FP values from memory conditioned on mask specified by xmm2. Conditionally gathered elements are merged into xmm1. +VEX.DDS.128.66.0F38.W0 93 /r VGATHERQPS xmm1, vm64x, xmm2 RMV Z, R, R V V AVX2 vgatherqps Using qword indices specified in vm64x, gather single-precision FP values from memory conditioned on mask specified by xmm2. Conditionally gathered elements are merged into xmm1. +VEX.DDS.256.66.0F38.W0 92 /r VGATHERDPS ymm1, vm32y, ymm2 RMV W, R, R V V AVX2 vgatherdps Using dword indices specified in vm32x, gather single-precision FP values from memory conditioned on mask specified by ymm2. Conditionally gathered elements are merged into ymm1. +VEX.DDS.256.66.0F38.W0 93 /r VGATHERQPS xmm1, vm64y, xmm2 RMV Z, R, R V V AVX2 vgatherqps Using qword indices specified in vm64y, gather single-precision FP values from memory conditioned on mask specified by ymm2. Conditionally gathered elements are merged into ymm1. + +VEX.DDS.128.66.0F38.W0 90 /r VPGATHERDD xmm1, vm32x, xmm2 RMV Z, R, R V V AVX2 vpgatherdd Using dword indices specified in vm32x, gather dword values from memory conditioned on mask specified by xmm2. Conditionally gathered elements are merged into xmm1. +VEX.DDS.128.66.0F38.W0 91 /r VPGATHERQD xmm1, vm64x, xmm2 RMV Z, R, R V V AVX2 vpgatherqd Using qword indices specified in vm64x, gather dword values from memory conditioned on mask specified by xmm2. Conditionally gathered elements are merged into xmm1. +VEX.DDS.256.66.0F38.W0 90 /r VPGATHERDD ymm1, vm32y, ymm2 RMV W, R, R V V AVX2 vpgatherdd Using dword indices specified in vm32y, gather dword from memory conditioned on mask specified by ymm2. Conditionally gathered elements are merged into ymm1. +VEX.DDS.256.66.0F38.W0 91 /r VPGATHERQD xmm1, vm64y, xmm2 RMV Z, R, R V V AVX2 vpgatherqd Using qword indices specified in vm64y, gather dword values from memory conditioned on mask specified by xmm2. Conditionally gathered elements are merged into xmm1. + +VEX.DDS.128.66.0F38.W1 90 /r VPGATHERDQ xmm1, vm32x, xmm2 RMV Z, R, R V V AVX2 vpgatherdq Using dword indices specified in vm32x, gather qword values from memory conditioned on mask specified by xmm2. Conditionally gathered elements are merged into xmm1. +VEX.DDS.128.66.0F38.W1 91 /r VPGATHERQQ xmm1, vm64x, xmm2 RMV Z, R, R V V AVX2 vpgatherqq Using qword indices specified in vm64x, gather qword values from memory conditioned on mask specified by xmm2. Conditionally gathered elements are merged into xmm1. +VEX.DDS.256.66.0F38.W1 90 /r VPGATHERDQ ymm1, vm32x, ymm2 RMV W, R, R V V AVX2 vpgatherdq Using dword indices specified in vm32x, gather qword values from memory conditioned on mask specified by ymm2. Conditionally gathered elements are merged into ymm1. +VEX.DDS.256.66.0F38.W1 91 /r VPGATHERQQ ymm1, vm64y, ymm2 RMV W, R, R V V AVX2 vpgatherqq Using qword indices specified in vm64y, gather qword values from memory conditioned on mask specified by ymm2. Conditionally gathered elements are merged into ymm1. + +VEX.NDS.256.66.0F3A.W0 18 /r ib VINSERTF128 ymm1, ymm2, xmm3/m128, imm8 RVMI W, R, R, R V V AVX vinsertf128 Insert a single precision floating-point value selected by imm8 from xmm3/m128 into ymm2 at the specified destination element specified by imm8 and zero out destination elements in ymm1 as indicated in imm8. + +VEX.NDS.256.66.0F3A.W0 38 /r ib VINSERTI128 ymm1, ymm2, xmm3/m128, imm8 RVMI W, R, R, R V V AVX2 vinserti128 Insert 128-bits of integer data from xmm3/mem and the remaining values from ymm2 into ymm1. + +VEX.NDS.128.66.0F38.W0 2C /r VMASKMOVPS xmm1, xmm2, m128 RVM Z, R, R V V AVX vmaskmovps Conditionally load packed single-precision values from m128 using mask in xmm2 and store in xmm1. +VEX.NDS.256.66.0F38.W0 2C /r VMASKMOVPS ymm1, ymm2, m256 RVM W, R, R V V AVX vmaskmovps Conditionally load packed single-precision values from m256 using mask in ymm2 and store in ymm1. +VEX.NDS.128.66.0F38.W0 2D /r VMASKMOVPD xmm1, xmm2, m128 RVM Z, R, R V V AVX vmaskmovpd Conditionally load packed double-precision values from m128 using mask in xmm2 and store in xmm1. +VEX.NDS.256.66.0F38.W0 2D /r VMASKMOVPD ymm1, ymm2, m256 RVM W, R, R V V AVX vmaskmovpd Conditionally load packed double-precision values from m256 using mask in ymm2 and store in ymm1. +VEX.NDS.128.66.0F38.W0 2E /r VMASKMOVPS m128, xmm1, xmm2 MVR W, R, R V V AVX vmaskmovps Conditionally store packed single-precision values from xmm2 using mask in xmm1. +VEX.NDS.256.66.0F38.W0 2E /r VMASKMOVPS m256, ymm1, ymm2 MVR W, R, R V V AVX vmaskmovps Conditionally store packed single-precision values from ymm2 using mask in ymm1. +VEX.NDS.128.66.0F38.W0 2F /r VMASKMOVPD m128, xmm1, xmm2 MVR W, R, R V V AVX vmaskmovpd Conditionally store packed double-precision values from xmm2 using mask in xmm1. +VEX.NDS.256.66.0F38.W0 2F /r VMASKMOVPD m256, ymm1, ymm2 MVR W, R, R V V AVX vmaskmovpd Conditionally store packed double-precision values from ymm2 using mask in ymm1. + +VEX.NDS.128.66.0F3A.W0 02 /r ib VPBLENDD xmm1, xmm2, xmm3/m128, imm8 RVMI Z, R, R, R V V AVX2 vpblendd Select dwords from xmm2 and xmm3/m128 from mask specified in imm8 and store the values into xmm1. +VEX.NDS.256.66.0F3A.W0 02 /r ib VPBLENDD ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX2 vpblendd Select dwords from ymm2 and ymm3/m256 from mask specified in imm8 and store the values into ymm1. + +VEX.128.66.0F38.W0 78 /r VPBROADCASTB xmm1, xmm2/m8 RM Z, R V V AVX2 vpbroadcastb Broadcast a byte integer in the source operand to sixteen locations in xmm1. +VEX.256.66.0F38.W0 78 /r VPBROADCASTB ymm1, xmm2/m8 RM W, R V V AVX2 vpbroadcastb Broadcast a byte integer in the source operand to thirty two locations in ymm1. +VEX.128.66.0F38.W0 79 /r VPBROADCASTW xmm1, xmm2/m16 RM Z, R V V AVX2 vpbroadcastw Broadcast a word integer in the source operand to eight locations in xmm1. +VEX.256.66.0F38.W0 79 /r VPBROADCASTW ymm1, xmm2/m16 RM W, R V V AVX2 vpbroadcastw Broadcast a word integer in the source operand to sixteen locations in ymm1. +VEX.128.66.0F38.W0 58 /r VPBROADCASTD xmm1, xmm2/m32 RM Z, R V V AVX2 vpbroadcastd Broadcast a dword integer in the source operand to four locations in xmm1. +VEX.256.66.0F38.W0 58 /r VPBROADCASTD ymm1, xmm2/m32 RM W, R V V AVX2 vpbroadcastd Broadcast a dword integer in the source operand to eight locations in ymm1. +VEX.128.66.0F38.W0 59 /r VPBROADCASTQ xmm1, xmm2/m64 RM Z, R V V AVX2 vpbroadcastq Broadcast a qword element in mem to two locations in xmm1 +VEX.256.66.0F38.W0 59 /r VPBROADCASTQ ymm1, xmm2/m64 RM W, R V V AVX2 vpbroadcastq Broadcast a qword element in mem to four locations in ymm1 +VEX.256.66.0F38.W0 5A /r VBROADCASTI128 ymm1, m128 RM W, R V V AVX2 vbroadcasti128 Broadcast 128 bits of integer data in mem to low and high 128-bits in ymm1. + +VEX.NDS.256.66.0F38.W0 36 /r VPERMD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpermd Permute doublewords in ymm3/m256 using indexes in ymm2 and store the result in ymm1. + +VEX.256.66.0F3A.W1 01 /r ib VPERMPD ymm1, ymm2/m256, imm8 RMI W, R, R V V AVX2 vpermpd Permute double-precision floating-point elements in ymm2/m256 using indexes in imm8 and store the result in ymm1. + +VEX.NDS.256.66.0F38.W0 16 /r VPERMPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpermps Permute single-precision floating-point elements in ymm3/m256 using indexes in ymm2 and store the result in ymm1. + +VEX.256.66.0F3A.W1 00 /r ib VPERMQ ymm1, ymm2/m256, imm8 RMI W, R, R V V AVX2 vpermq Permute qwords in ymm2/m256 using indexes in imm8 and store the result in ymm1. + +VEX.NDS.256.66.0F3A.W0 46 /r ib VPERM2I128 ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX2 vperm2i128 Permute 128-bit integer data in ymm2 and ymm3/mem using controls from imm8 and store result in ymm1. + +VEX.NDS.128.66.0F38.W0 0D /r VPERMILPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpermilpd Permute double-precision floating-point values in xmm2 using controls from xmm3/mem and store result in xmm1. +VEX.NDS.256.66.0F38.W0 0D /r VPERMILPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vpermilpd Permute double-precision floating-point values in ymm2 using controls from ymm3/mem and store result in ymm1. +VEX.128.66.0F3A.W0 05 /r ib VPERMILPD xmm1, xmm2/m128, imm8 RMI Z, R, R V V AVX vpermilpd Permute double-precision floating-point values in xmm2/mem using controls from imm8. +VEX.256.66.0F3A.W0 05 /r ib VPERMILPD ymm1, ymm2/m256, imm8 RMI W, R, R V V AVX vpermilpd Permute double-precision floating-point values in ymm2/mem using controls from imm8. + +VEX.NDS.128.66.0F38.W0 0C /r VPERMILPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vpermilps Permute single-precision floating-point values in xmm2 using controls from xmm3/mem and store result in xmm1. +VEX.128.66.0F3A.W0 04 /r ib VPERMILPS xmm1, xmm2/m128, imm8 RMI Z, R, R V V AVX vpermilps Permute single-precision floating-point values in xmm2/mem using controls from imm8 and store result in xmm1. +VEX.NDS.256.66.0F38.W0 0C /r VPERMILPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vpermilps Permute single-precision floating-point values in ymm2 using controls from ymm3/mem and store result in ymm1. +VEX.256.66.0F3A.W0 04 /r ib VPERMILPS ymm1, ymm2/m256, imm8 RMI W, R, R V V AVX vpermilps Permute single-precision floating-point values in ymm2/mem using controls from imm8 and store result in ymm1. + +VEX.NDS.256.66.0F3A.W0 06 /r ib VPERM2F128 ymm1, ymm2, ymm3/m256, imm8 RVMI W, R, R, R V V AVX vperm2f128 Permute 128-bit floating-point fields in ymm2 and ymm3/mem using controls from imm8 and store result in ymm1. + +VEX.NDS.128.66.0F38.W0 8C /r VPMASKMOVD xmm1, xmm2, m128 RVM Z, R, R V V AVX2 vpmaskmovd Conditionally load dword values from m128 using mask in xmm2 and store in xmm1. +VEX.NDS.256.66.0F38.W0 8C /r VPMASKMOVD ymm1, ymm2, m256 RVM W, R, R V V AVX2 vpmaskmovd Conditionally load dword values from m256 using mask in ymm2 and store in ymm1. +VEX.NDS.128.66.0F38.W1 8C /r VPMASKMOVQ xmm1, xmm2, m128 RVM Z, R, R V V AVX2 vpmaskmovq Conditionally load qword values from m128 using mask in xmm2 and store in xmm1. +VEX.NDS.256.66.0F38.W1 8C /r VPMASKMOVQ ymm1, ymm2, m256 RVM W, R, R V V AVX2 vpmaskmovq Conditionally load qword values from m256 using mask in ymm2 and store in ymm1. +VEX.NDS.128.66.0F38.W0 8E /r VPMASKMOVD m128, xmm1, xmm2 MVR W, R, R V V AVX2 vpmaskmovd Conditionally store dword values from xmm2 using mask in xmm1. +VEX.NDS.256.66.0F38.W0 8E /r VPMASKMOVD m256, ymm1, ymm2 MVR W, R, R V V AVX2 vpmaskmovd Conditionally store dword values from ymm2 using mask in ymm1. +VEX.NDS.128.66.0F38.W1 8E /r VPMASKMOVQ m128, xmm1, xmm2 MVR W, R, R V V AVX2 vpmaskmovq Conditionally store qword values from xmm2 using mask in xmm1. +VEX.NDS.256.66.0F38.W1 8E /r VPMASKMOVQ m256, ymm1, ymm2 MVR W, R, R V V AVX2 vpmaskmovq Conditionally store qword values from ymm2 using mask in ymm1. + +VEX.NDS.128.66.0F38.W0 47 /r VPSLLVD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX2 vpsllvd Shift bits in doublewords in xmm2 left by amount specified in the corresponding element of xmm3/m128 while shifting in 0s. +VEX.NDS.128.66.0F38.W1 47 /r VPSLLVQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX2 vpsllvq Shift bits in quadwords in xmm2 left by amount specified in the corresponding element of xmm3/m128 while shifting in 0s. +VEX.NDS.256.66.0F38.W0 47 /r VPSLLVD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsllvd Shift bits in doublewords in ymm2 left by amount specified in the corresponding element of ymm3/m256 while shifting in 0s. +VEX.NDS.256.66.0F38.W1 47 /r VPSLLVQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsllvq Shift bits in quadwords in ymm2 left by amount specified in the corresponding element of ymm3/m256 while shifting in 0s. + +VEX.NDS.128.66.0F38.W0 46 /r VPSRAVD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX2 vpsravd Shift bits in doublewords in xmm2 right by amount specified in the corresponding element of xmm3/m128 while shifting in the sign bits. +VEX.NDS.256.66.0F38.W0 46 /r VPSRAVD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsravd Shift bits in doublewords in ymm2 right by amount specified in the corresponding element of ymm3/m256 while shifting in the sign bits. + +VEX.NDS.128.66.0F38.W0 45 /r VPSRLVD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX2 vpsrlvd Shift bits in doublewords in xmm2 right by amount specified in the corresponding element of xmm3/m128 while shifting in 0s. +VEX.NDS.128.66.0F38.W1 45 /r VPSRLVQ xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX2 vpsrlvq Shift bits in quadwords in xmm2 right by amount specified in the corresponding element of xmm3/m128 while shifting in 0s. +VEX.NDS.256.66.0F38.W0 45 /r VPSRLVD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsrlvd Shift bits in doublewords in ymm2 right by amount specified in the corresponding element of ymm3/m256 while shifting in 0s. +VEX.NDS.256.66.0F38.W1 45 /r VPSRLVQ ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX2 vpsrlvq Shift bits in quadwords in ymm2 right by amount specified in the corresponding element of ymm3/m256 while shifting in 0s. + +VEX.128.66.0F38.W0 0E /r VTESTPS xmm1, xmm2/m128 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V AVX vtestps Set ZF and CF depending on sign bit AND and ANDN of packed single-precision floating- point sources. +VEX.256.66.0F38.W0 0E /r VTESTPS ymm1, ymm2/m256 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V AVX vtestps Set ZF and CF depending on sign bit AND and ANDN of packed single-precision floating- point sources. +VEX.128.66.0F38.W0 0F /r VTESTPD xmm1, xmm2/m128 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V AVX vtestpd Set ZF and CF depending on sign bit AND and ANDN of packed double-precision floating- point sources. +VEX.256.66.0F38.W0 0F /r VTESTPD ymm1, ymm2/m256 RM R, R E.OF E.SF E.ZF E.AF E.CF E.PF V V AVX vtestpd Set ZF and CF depending on sign bit AND and ANDN of packed double-precision floating- point sources. + +VEX.256.0F.WIG 77 VZEROALL NP YMM* V V AVX vzeroall Zero all YMM registers. + +VEX.128.0F.WIG 77 VZEROUPPER NP XMM* YMM* V V AVX vzeroupper Zero upper 128 bits of all YMM registers. + +9B WAIT NP S.C0 S.C1 S.C2 S.C3 V V FPU wait Check pending unmasked floating-point exceptions. +9B FWAIT NP S.C0 S.C1 S.C2 S.C3 V V FPU fwait Check pending unmasked floating-point exceptions. + +0F 09 WBINVD NO YES V V Write back and flush Internal caches; initiate writing-back and flushing of external caches. + +F3 0F AE /2 WRFSBASE r32 M R V I FSGSBASE wrfsbase Load the FS base address with the 32-bit value in the source register. +REX.W+ F3 0F AE /2 WRFSBASE r64 M R V I FSGSBASE wrfsbase Load the FS base address with the 64-bit value in the source register. +F3 0F AE /3 WRGSBASE r32 M R V I FSGSBASE wrgsbase Load the GS base address with the 32-bit value in the source register. +REX.W+ F3 0F AE /3 WRGSBASE r64 M R V I FSGSBASE wrgsbase Load the GS base address with the 64-bit value in the source register. + +0F 30 WRMSR NO YES V V Write the value in EDX:EAX to MSR specified by ECX. + +F2 XACQUIRE NP V V HLE xacquire A hint used with an "XACQUIRE-enabled" instruction to start lock elision on the instruction memory operand address. +F3 XRELEASE NP V V HLE xrelease A hint used with an "XRELEASE-enabled" instruction to end lock elision on the instruction memory operand address. + +C6 F8 ib XABORT imm8 I R V V RTM xabort Causes an RTM abort if in RTM execution + +0F C0 /r XADD r/m8, r8 MR RW, RW E.OF E.SF E.ZF E.AF E.CF E.PF V V xaddb Exchange r8 and r/m8; load sum into r/m8. +REX+ 0F C0 /r XADD r/m8, r8 MR RW, RW E.OF E.SF E.ZF E.AF E.CF E.PF V NE xaddb Exchange r8 and r/m8; load sum into r/m8. +0F C1 /r XADD r/m16, r16 MR RW, RW E.OF E.SF E.ZF E.AF E.CF E.PF V V xaddw Exchange r16 and r/m16; load sum into r/m16. +0F C1 /r XADD r/m32, r32 MR RW, RW E.OF E.SF E.ZF E.AF E.CF E.PF V V xaddl Exchange r32 and r/m32; load sum into r/m32. +REX.W+ 0F C1 /r XADD r/m64, r64 MR RW, RW E.OF E.SF E.ZF E.AF E.CF E.PF V NE xaddq Exchange r64 and r/m64; load sum into r/m64. + +C7 F8 XBEGIN rel16 A R NS V RTM xbegin Specifies the start of an RTM region. Provides a 16-bit relative offset to compute the address of the fallback instruction address at which execution resumes following an RTM abort. +C7 F8 XBEGIN rel32 A R V V RTM xbegin Specifies the start of an RTM region. Provides a 32-bit relative offset to compute the address of the fallback instruction address at which execution resumes following an RTM abort. + +90 +rw XCHG AX, r16 O RW, RW V V xchgw Exchange r16 with AX. +90 +rw XCHG r16, AX O RW, RW V V xchgw Exchange AX with r16. +90 +rd XCHG EAX, r32 O RW, RW V V xchgl Exchange r32 with EAX. +REX.W+ 90 +rd XCHG RAX, r64 O RW, RW V NE xchgq Exchange r64 with RAX. +90 +rd XCHG r32, EAX O RW, RW V V xchgl Exchange EAX with r32. +REX.W+ 90 +rd XCHG r64, RAX O RW, RW V NE xchgq Exchange RAX with r64. +86 /r XCHG r/m8, r8 MR RW, RW V V xchgb YES Exchange r8 (byte register) with byte from r/m8. +REX+ 86 /r XCHG r/m8, r8 MR RW, RW V NE xchgb Exchange r8 (byte register) with byte from r/m8. +86 /r XCHG r8, r/m8 RM RW, RW V V xchgb Exchange byte from r/m8 with r8 (byte register). +REX+ 86 /r XCHG r8, r/m8 RM RW, RW V NE xchgb Exchange byte from r/m8 with r8 (byte register). +87 /r XCHG r/m16, r16 MR RW, RW V V xchgw YES Exchange r16 with word from r/m16. +87 /r XCHG r16, r/m16 RM RW, RW V V xchgw Exchange word from r/m16 with r16. +87 /r XCHG r/m32, r32 MR RW, RW V V xchgl YES Exchange r32 with doubleword from r/m32. +REX.W+ 87 /r XCHG r/m64, r64 MR RW, RW V NE xchgq YES Exchange r64 with quadword from r/m64. +87 /r XCHG r32, r/m32 RM RW, RW V V xchgl Exchange doubleword from r/m32 with r32. +REX.W+ 87 /r XCHG r64, r/m64 RM RW, RW V NE xchgq Exchange quadword from r/m64 with r64. + +0F 01 D5 XEND NP V V RTM xend Specifies the end of an RTM code region. + +0F 01 D0 XGETBV NP ECX EAX EDX YES NO V V XSAVE xgetbv Reads an XCR specified by ECX into EDX:EAX. + +D7 XLAT m8 NP I AL DS BX ebx AL V V xlat Set AL to memory byte DS:[(E)BX + unsigned AL]. +D7 XLATB NP AL DS BX ebx AL V V xlatb YES Set AL to memory byte DS:[(E)BX + unsigned AL]. +REX.W+ D7 XLATB NP AL RBX AL V NE xlatb Set AL to memory byte [RBX + unsigned AL]. + +34 ib XOR AL, imm8 I RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorb AL XOR imm8. +35 iw XOR AX, imm16 I RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorw AX XOR imm16. +35 id XOR EAX, imm32 I RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorl EAX XOR imm32. +REX.W+ 35 id XOR RAX, imm32 I RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE xorq RAX XOR imm32 (sign-extended). +80 /6 ib XOR r/m8, imm8 MI RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorb r/m8 XOR imm8. +REX+ 80 /6 ib XOR r/m8, imm8 MI RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE xorb r/m8 XOR imm8. +81 /6 iw XOR r/m16, imm16 MI RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorw r/m16 XOR imm16. +81 /6 id XOR r/m32, imm32 MI RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorl r/m32 XOR imm32. +REX.W+ 81 /6 id XOR r/m64, imm32 MI RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE xorq r/m64 XOR imm32 (sign-extended). +83 /6 ib XOR r/m16, imm8 MI RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorw YES r/m16 XOR imm8 (sign-extended). +83 /6 ib XOR r/m32, imm8 MI RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorl YES r/m32 XOR imm8 (sign-extended). +REX.W+ 83 /6 ib XOR r/m64, imm8 MI RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE xorq YES r/m64 XOR imm8 (sign-extended). +30 /r XOR r/m8, r8 MR RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorb YES r/m8 XOR r8. +REX+ 30 /r XOR r/m8, r8 MR RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE xorb YES r/m8 XOR r8. +31 /r XOR r/m16, r16 MR RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorw YES r/m16 XOR r16. +31 /r XOR r/m32, r32 MR RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorl YES r/m32 XOR r32. +REX.W+ 31 /r XOR r/m64, r64 MR RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE xorq YES r/m64 XOR r64. +32 /r XOR r8, r/m8 RM RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorb r8 XOR r/m8. +REX+ 32 /r XOR r8, r/m8 RM RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE xorb r8 XOR r/m8. +33 /r XOR r16, r/m16 RM RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorw r16 XOR r/m16. +33 /r XOR r32, r/m32 RM RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V V xorl r32 XOR r/m32. +REX.W+ 33 /r XOR r64, r/m64 RM RW, R E.OF E.SF E.ZF E.CF E.PF E.AF V NE xorq r64 XOR r/m64. + +66 0F 57 /r XORPD xmm1, xmm2/m128 RM RW, R V V SSE2 xorpd Bitwise exclusive-OR of xmm2/m128 and xmm1. +VEX.NDS.128.66.0F.WIG 57 /r VXORPD xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vxorpd Return the bitwise logical XOR of packed double-precision floating-point values in xmm2 and xmm3/mem. +VEX.NDS.256.66.0F.WIG 57 /r VXORPD ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vxorpd Return the bitwise logical XOR of packed double-precision floating-point values in ymm2 and ymm3/mem. + +0F 57 /r XORPS xmm1, xmm2/m128 RM RW, R V V SSE xorps Bitwise exclusive-OR of xmm2/m128 and xmm1. +VEX.NDS.128.0F.WIG 57 /r VXORPS xmm1, xmm2, xmm3/m128 RVM Z, R, R V V AVX vxorps Return the bitwise logical XOR of packed single-precision floating-point values in xmm2 and xmm3/mem. +VEX.NDS.256.0F.WIG 57 /r VXORPS ymm1, ymm2, ymm3/m256 RVM W, R, R V V AVX vxorps Return the bitwise logical XOR of packed single-precision floating-point values in ymm2 and ymm3/mem. + +0F AE /5 XRSTOR mem M R ??? ??? ??? V V XSAVE xrstor Restore processor extended states from memory. The states are specified by EDX:EAX +REX.W+ 0F AE /5 XRSTOR64 mem M R ??? ??? ??? V NE XSAVE xrstor64 Restore processor extended states from memory. The states are specified by EDX:EAX + +0F AE /4 XSAVE mem M W ??? ??? ??? V V XSAVE xsave Save processor extended states to memory. The states are specified by EDX:EAX +REX.W+ 0F AE /4 XSAVE64 mem M W ??? ??? ??? V NE XSAVE xsave64 Save processor extended states to memory. The states are specified by EDX:EAX + +0F AE /6 XSAVEOPT mem M W ??? ??? ??? V V XSAVEOPT xsaveopt Save processor extended states specified in EDX:EAX to memory, optimizing the state save operation if possible. +REX.W+ 0F AE /6 XSAVEOPT64 mem M W ??? ??? ??? V V XSAVEOPT xsaveopt64 Save processor extended states specified in EDX:EAX to memory, optimizing the state save operation if possible. + +0F 01 D1 XSETBV NO* YES V V Write the value in EDX:EAX to the XCR specified by ECX. + +0F 01 D6 XTEST NP V V RTM xtest Test if executing in a transactional region +' +! ! + + +InstructionSpec initialize! + diff --git a/modules/LMR/Nativizer/Assembly/Intel/IntelModule.Class.st b/modules/LMR/Nativizer/Assembly/Intel/IntelModule.Class.st new file mode 100644 index 00000000..6587edad --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/IntelModule.Class.st @@ -0,0 +1,39 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #IntelModule category: #'Powerlang-Core-Assembler-Intel'! +Module subclass: #IntelModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!IntelModule commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!IntelModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +imports + ^{ + #Kernel -> #(ByteArray). + #LMR -> #(NativeCode). + #'LMR.Nativizer.Assembly' -> #(ABI Assembler CodeGenerator RelocatableBuffer) + } +! ! + +!IntelModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +justLoaded + super justLoaded. + ISAOperandType initializeOperandTypeFlags; initializeTypes. + InstructionPrefix initializePrefixes. + Register addNamespace: ISAOperandType operandTypeFlags; initializeRegisters; initializeFamilies. + ISAOperandType addNamespace: Register registers +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IntelModule class' category: #'Powerlang-Core-Assembler-Intel'! +IntelModule class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/LegacyPrefix.Class.st b/modules/LMR/Nativizer/Assembly/Intel/LegacyPrefix.Class.st new file mode 100644 index 00000000..69dda270 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/LegacyPrefix.Class.st @@ -0,0 +1,141 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #LegacyPrefix category: #'Powerlang-Core-Assembler-Intel'! +InstructionPrefix subclass: #LegacyPrefix + instanceVariableNames: 'group value' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!LegacyPrefix commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!LegacyPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +group + ^group +! ! + +!LegacyPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +group: anInteger + group := anInteger +! ! + +!LegacyPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLegacy + ^true +! ! + +!LegacyPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +matches: aLegacyPrefix + ^self == aLegacyPrefix +! ! + +!LegacyPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +overridesAddressSize + ^self = AddressSize_Override +! ! + +!LegacyPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +overridesOperandSize + ^self = OperandSize_Override +! ! + +!LegacyPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^value +! ! + +!LegacyPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: anInteger + value := anInteger +! ! + +!LegacyPrefix methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeOn: instruction + instruction writeLegacyPrefix: value +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LegacyPrefix class' category: #'Powerlang-Core-Assembler-Intel'! +LegacyPrefix class + instanceVariableNames: ''! + +!LegacyPrefix class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +addressSizeOverride + ^AddressSize_Override +! ! + +!LegacyPrefix class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeGroup1 + #(#(0xF0 'LOCK') #(0xF2 'REPNE/REPNZ') #(0xF3 'REP/REPE/REPZ')) + do: [:pair | | names prefix | + names := $/ split: pair second. + prefix := self new + group: 1; + value: pair first; + name: names first. + names do: [:aka | Prefixes at: aka put: prefix]] +! ! + +!LegacyPrefix class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeGroup2 + #(#(0x2E 'CS') #(0x36 'SS') #(0x3E 'DS') #(0x26 'ES') #(0x64 FS) #(0x65 'GS')) + do: [:pair | | prefix | + prefix := self new + group: 2; + value: pair first; + name: pair second , ' segment override'. + self disableCode: [Prefixes at: prefix name put: prefix]]. + #(#(0x2E 'not') #(0x3E '')) do: [:pair | | prefix | + prefix := self new + group: 2; + value: pair first; + name: 'Branch ' , pair second , ' taken'. + self disableCode: [Prefixes at: prefix name put: prefix]] +! ! + +!LegacyPrefix class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeGroup3 + | prefix | + prefix := self new + group: 3; + value: 16r66; + name: 'OperandSize_Override'. + Prefixes at: prefix name put: prefix +! ! + +!LegacyPrefix class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeGroup4 + | prefix | + prefix := self new + group: 4; + value: 16r67; + name: 'AddressSize_Override'. + Prefixes at: prefix name put: prefix +! ! + +!LegacyPrefix class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializePrefixes + self + initializeGroup1; + initializeGroup2; + initializeGroup3; + initializeGroup4. +! ! + +!LegacyPrefix class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +operandSizeOverride + ^OperandSize_Override +! ! + +!LegacyPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +withValue: byte + ^Prefixes + detect: [:prefix | prefix isLegacy and: [prefix value = byte]] + ifNone: nil +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/MemoryOperand.Class.st b/modules/LMR/Nativizer/Assembly/Intel/MemoryOperand.Class.st new file mode 100644 index 00000000..b5364a81 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/MemoryOperand.Class.st @@ -0,0 +1,343 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #MemoryOperand category: #'Powerlang-Core-Assembler-Intel'! +ISAOperand subclass: #MemoryOperand + instanceVariableNames: 'base index scale displacement segment' + classVariableNames: '' + poolDictionaries: 'Registers' + category: 'Powerlang-Core-Assembler-Intel'! +!MemoryOperand commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!MemoryOperand methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! += operand + self class == operand class ifFalse: [^false]. + length = operand length ifFalse: [^false]. + base = operand base ifFalse: [^false]. + index = operand index ifFalse: [^false]. + self scale = operand scale ifFalse: [^false]. + displacement = operand displacement ifFalse: [^false]. + ^segment = operand segment +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +base + ^base +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +base: aRegister + base := aRegister +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +baseExtension + ^base notNil ifTrue: [base extensionBit] ifFalse: [0] +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +displacement + ^displacement + +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +displacement: anInteger + self ASSERT: anInteger isInteger. + self ASSERT: (anInteger between: -2147483648 and: 2147483647). + displacement := anInteger + +! ! + +!MemoryOperand methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +displacementBytes + | bytes displ n | + n := (base notNil and: [displacement between: -128 and: 127]) + ifTrue: [1] + ifFalse: [4]. + base == rip ifTrue: [n := 4]. + bytes := ByteArray new: n. + displ := displacement. + 1 to: bytes size do: [:i | + bytes at: i put: (displ bitAnd: 16rFF). + displ := displ bitShift: -8]. + ^bytes +! ! + +!MemoryOperand methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +displacementLength + displacement = 0 ifTrue: [^0]. + ^(base notNil and: [displacement between: -128 and: 127]) + ifTrue: [1] + ifFalse: [4] +! ! + +!MemoryOperand methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +displacementValue + | value | + displacement isNumber ifTrue: [^displacement]. + displacement size = 4 ifTrue: [^displacement longAtOffset: 0]. + displacement size = 2 ifTrue: [^displacement shortAtOffset: 0]. + value := displacement at: 1. + (value isOnBit: 16r80) ifTrue: [^value - (1 bitShift: displacement size * 8)]. + ^value +! ! + +!MemoryOperand methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeSib: aSIB + | s i b | + s := scale ifNil: 1. + i := index isNil ifTrue: [rsp index] ifFalse: [index index \\ 8]. + b := base isNil ifTrue: [rbp index] ifFalse: [base index \\ 8]. + aSIB + scaleFactor: s; + index: i; + base: b +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasDisplacement + ^self hasExplicitDisplacement + or: [base isNil] + or: [self requiresSpecialCaseDisplacement] +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasExplicitDisplacement + ^displacement !!= 0 +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasOnlyDisplacement + ^index isNil and: [base isNil] +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasSib + ^index notNil or: [self requiresSpecialCaseSib] +! ! + +!MemoryOperand methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hash + ^length + hashWith: base + with: index + with: scale + with: displacement + with: segment +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^index +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: aRegister + index := aRegister +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +indexExtension + ^index notNil ifTrue: [index extensionBit] ifFalse: [0] +! ! + +!MemoryOperand methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + displacement := 0. + scale := 1 +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCompatibleWith: anOperandType + ^anOperandType isMemory + and: [length = anOperandType memoryLength + or: [anOperandType memoryLength isNil]] +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDirectMemoryReference + ^self hasOnlyDisplacement +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isMemory + ^true +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isTemplate + ^displacement = 0 +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +length: anInteger + self ASSERT: (#(8 16 32 64 128) includes: anInteger). + length := anInteger + +! ! + +!MemoryOperand methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +lengthString + length = 256 ifTrue: [^'ymmword ptr']. + length = 128 ifTrue: [^'xmmword ptr']. + (length isNil or: [length = 64]) ifTrue: [^'qword ptr']. + length = 32 ifTrue: [^'dword ptr']. + length = 16 ifTrue: [^'word ptr']. + length = 8 ifTrue: [^'byte ptr']. + self ASSERT: false. + ^'' +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +memoryLength + ^length +! ! + +!MemoryOperand methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +mod + base == rip ifTrue: [^2r0]. + base isNil ifTrue: [^0]. + self hasDisplacement ifFalse: [^0]. + (displacement between: -128 and: 127) ifTrue: [^2r1] ifFalse: [^2r10] +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +needsExtraBit + (base notNil and: [base needsExtraBit]) ifTrue: [^true]. + ^index notNil and: [index needsExtraBit] +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +pointerLength + base notNil ifTrue: [^base length]. + ^self displacementLength +! ! + +!MemoryOperand methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + | sign displ | + aStream nextPutAll: self lengthString; nextPutAll: ' ['. + segment notNil ifTrue: [ + segment printOn: aStream. + aStream nextPut: $:]. + base notNil ifTrue: [base printOn: aStream]. + index notNil ifTrue: [ + base notNil ifTrue: [aStream nextPutAll: ' + ']. + index printOn: aStream. + scale isNil + ifFalse: [aStream nextPutAll: ' * '; nextPutAll: scale asString]]. + displ := self displacementValue. + displ !!= 0 ifTrue: [ + (base notNil or: [index notNil]) ifTrue: [ + sign := displ > 0 ifTrue: [' + '] ifFalse: [' - ']. + aStream nextPutAll: sign]. + aStream nextPutAll: '0x'; nextPutAll: displ abs hex]. + aStream nextPut: $] +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +requiresSpecialCaseDisplacement + ^base notNil and: [base == r13 or: [base r == rbp]] +! ! + +!MemoryOperand methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +requiresSpecialCaseSib + base ifNil: [^true]. + ^base == r12 or: [base r == rsp] +! ! + +!MemoryOperand methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +reset + base := index := segment := length := nil. + displacement := 0. + scale := 1 +! ! + +!MemoryOperand methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +rm + self hasSib ifTrue: [^2r100]. + ^base ifNil: [2r101] ifNotNil: [base index] +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +scale + ^scale + +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +scale: anInteger + self ASSERT: (#(1 2 4 8) includes: anInteger). + scale := anInteger + +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +segment + ^segment +! ! + +!MemoryOperand methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +segment: aRegister + segment := aRegister +! ! + +!MemoryOperand methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +sib + | factor s i b | + factor := scale ifNil: 1. + s := #[1 2 4 8] indexOf: factor. + i := index isNil ifTrue: [rsp index] ifFalse: [index index bitAnd: 8r7]. + b := base isNil ifTrue: [rbp index] ifFalse: [base index bitAnd: 8r7]. + ^((s - 1 bitShift: 6) bitOr: (i bitShift: 3)) bitOr: b +! ! + +!MemoryOperand methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +template + | template bits d | + template := self copy. + displacement = 0 ifTrue: [^template]. + bits := self displacementLength. + d := bits = 1 ifTrue: [16r3F] ifFalse: [16r3FFFFFFF]. + ^template displacement: d +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MemoryOperand class' category: #'Powerlang-Core-Assembler-Intel'! +MemoryOperand class + instanceVariableNames: ''! + +!MemoryOperand class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +fromStream: aStream + | memory | + memory := AssemblerParser new memory parse: aStream. + memory isPetitFailure + ifTrue: [self error: 'invalid operand: ' , memory message]. + ^memory +! ! + +!MemoryOperand class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +fromString: aString + " + MemoryOperand fromString: 'qword ptr [rbx]' + " + ^self fromStream: aString readStream +! ! + +!MemoryOperand class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +new + "return an initialized instance" + + ^ self basicNew initialize. + +! ! + + +MemoryOperand initialize! + diff --git a/modules/LMR/Nativizer/Assembly/Intel/OperandEncoding.Class.st b/modules/LMR/Nativizer/Assembly/Intel/OperandEncoding.Class.st new file mode 100644 index 00000000..077100e8 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/OperandEncoding.Class.st @@ -0,0 +1,994 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #OperandEncoding category: #'Powerlang-Core-Assembler-Intel'! +Object subclass: #OperandEncoding + instanceVariableNames: 'name selectors descriptions immediate modrm' + classVariableNames: 'Encodings' + poolDictionaries: 'Registers' + category: 'Powerlang-Core-Assembler-Intel'! +!OperandEncoding commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OperandEncoding methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +bytesFor: integer length: n + | bytes v | + bytes := ByteArray new: n. + v := integer. + v < 0 ifTrue: [v := v + (1 bitShift: n * 8)]. + 1 to: n do: [:i | | b | + b := v bitAnd: 16rFF. + bytes at: i put: b. + v := v bitShift: -8]. + ^bytes +! ! + +!OperandEncoding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +descriptions + ^descriptions +! ! + +!OperandEncoding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +descriptions: aCollection + descriptions := aCollection. + modrm := immediate := false. + (selectors conform: [:s | s beginsWith: 'encodeNP']) ifTrue: [^self]. + descriptions do: [:d | + (d includesString: 'ModRM') ifTrue: [modrm := true]. + (d includesString: 'offs') ifTrue: [immediate := true]. + (d includesString: 'imm') ifTrue: [immediate := true]] +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeAOperand1: operand + " + imm8 + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeDOperand1: instruction + " + offset + " + | op bytes | + op := instruction spec operands at: 1. + bytes := self bytesFor: instruction operand1 value length: op length // 8. + instruction immediate: bytes +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeFDOperand1: instruction + " + AL/AX/EAX/RAX + Moffs + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeFDOperand2: operand + " + AL/AX/EAX/RAX + Moffs + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeFVOperand1: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeFVOperand2: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeFVOperand3: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeFVRVMOperand1: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeFVRVMOperand2: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeFVRVMOperand3: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeIIOperand1: instruction + " + iw + imm8 + " + | op bytes | + op := instruction spec operands at: 1. + bytes := self bytesFor: instruction operand1 value length: op length // 8. + instruction immediate: bytes +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeIIOperand2: instruction + " + iw + imm8 + " + | op bytes | + op := instruction spec operands at: 2. + bytes := self bytesFor: instruction operand2 value length: op length // 8. + instruction immediate2: bytes +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeIOperand1: instruction + " + AL/AX/EAX/RAX + imm8 + " + " + do nothing + " + instruction arity = 1 ifTrue: [| op bytes | + op := instruction spec operands at: 1. + bytes := self bytesFor: instruction operand1 value length: op length // 8. + instruction immediate: bytes] +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeIOperand2: instruction + " + AL/AX/EAX/RAX + imm8 + " + | op bytes | + op := instruction spec operands at: 2. + bytes := self bytesFor: instruction operand2 value length: op length // 8. + instruction immediate: bytes +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeM1Operand1: instruction + " + ModRM:r/m (w) + 1 + " + instruction rm: instruction operand1 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeM1Operand2: instruction + " + ModRM:r/m (w) + 1 + " + " + do nothing + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMCOperand1: instruction + " + ModRM:r/m (w) + CL + " + instruction rm: instruction operand1 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMCOperand2: operand + " + ModRM:r/m (w) + CL + " + " + do nothing + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMIOperand1: instruction + " + ModRM:r/m (r, w) + imm8 + " + instruction rm: instruction operand1 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMIOperand2: instruction + " + ModRM:r/m (r, w) + imm8 + " + | op bytes | + op := instruction spec operands at: 2. + bytes := self bytesFor: instruction operand2 value length: op length // 8. + instruction immediate: bytes +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMOperand1: instruction + " + ModRM:r/m (r) + " + instruction rm: instruction operand1 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMRCOperand1: instruction + " + ModRM:r/m (w) + ModRM:reg (r) + CL + " + instruction rm: instruction operand1 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMRCOperand2: instruction + " + ModRM:r/m (w) + ModRM:reg (r) + CL + " + instruction reg: instruction operand2 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMRCOperand3: instruction + " + ModRM:r/m (w) + ModRM:reg (r) + CL + " + " + do nothing + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMRIOperand1: instruction + " + ModRM:r/m (w) + ModRM:reg (r) + imm8 + " + instruction rm: instruction operand1 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMRIOperand2: instruction + " + ModRM:r/m (w) + ModRM:reg (r) + imm8 + " + instruction reg: instruction operand2 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMRIOperand3: instruction + " + ModRM:r/m (w) + ModRM:reg (r) + imm8 + " + | op bytes | + op := instruction spec operands at: 3. + bytes := self bytesFor: instruction operand3 value length: op length // 8. + instruction immediate: bytes +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMROperand1: instruction + " + ModRM:r/m (r, w) + ModRM:reg (r) + " + instruction rm: instruction operand1 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMROperand2: instruction + " + ModRM:r/m (r, w) + ModRM:reg (r) + " + instruction reg: instruction operand2 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMVROperand1: instruction + " + ModRM:r/m (w) + VEX.vvvv (r) + ModRM:reg (r) + " + instruction vrm: instruction operand1 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMVROperand2: instruction + " + ModRM:r/m (w) + VEX.vvvv (r) + ModRM:reg (r) + " + instruction vvvv: instruction operand2 index +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeMVROperand3: instruction + " + ModRM:r/m (w) + VEX.vvvv (r) + ModRM:reg (r) + " + instruction vreg: instruction operand3 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeNPOperand1: instruction + " + ModRM:r/m (w) + ModRM:reg (r) + " + self ASSERT: instruction operand1 isImmediate +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeNPOperand2: operand + " + ModRM:r/m (w) + ModRM:reg (r) + " + self ASSERT: false +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeOIOperand1: instruction + " + opcode + rd (w) + imm8/16/32/64 + " + self encodeOOperand1: instruction +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeOIOperand2: instruction + " + opcode + rd (w) + imm8/16/32/64 + " + instruction operand2 length: instruction operand1 length. + instruction immediate: instruction operand2 bytes +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeOOperand1: instruction + " + opcode + rd (r, w) + " + | index i opcode | + index := instruction operand1 index. + i := index bitAnd: 2r111. + opcode := instruction spec primaryOpcode copy. + opcode at: opcode size put: opcode last + i. + index > 7 + ifTrue: [instruction rexB: true opcode: opcode] + ifFalse: [instruction opcode: opcode] +! ! + +!OperandEncoding methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeOperand: i of: instruction + | selector | + selector := selectors at: i. + self perform: selector with: instruction +! ! + +!OperandEncoding methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeOperands: instruction + 1 to: instruction arity do: [:i | self encodeOperand: i of: instruction] +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRM0Operand1: instruction + " + ModRM:reg (r, w) + ModRM:r/m (r) + " + instruction vreg: instruction operand1 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRM0Operand2: instruction + " + ModRM:reg (r, w) + ModRM:r/m (r) + " + instruction vrm: instruction operand2 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRMIOperand1: instruction + " + ModRM:reg (w) + ModRM:r/m (r) + imm8 + " + instruction reg: instruction operand1 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRMIOperand2: instruction + " + ModRM:reg (w) + ModRM:r/m (r) + imm8 + " + instruction rm: instruction operand2 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRMIOperand3: instruction + " + ModRM:reg (w) + ModRM:r/m (r) + imm8 + " + | op bytes | + op := instruction spec operands at: 3. + bytes := self bytesFor: instruction operand3 value length: op length // 8. + instruction immediate: bytes +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRMOperand1: instruction + " + ModRM:reg (r, w) + ModRM:r/m (r) + " + instruction reg: instruction operand1 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRMOperand2: instruction + " + ModRM:reg (r, w) + ModRM:r/m (r) + " + instruction rm: instruction operand2 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRMVOperand1: instruction + " + ModRM:reg (w) + ModRM:r/m (r) + VEX.vvvv (r) + " + instruction vreg: instruction operand1 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRMVOperand2: instruction + " + ModRM:reg (w) + ModRM:r/m (r) + VEX.vvvv (r) + " + instruction vrm: instruction operand2 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRMVOperand3: instruction + " + ModRM:reg (w) + ModRM:r/m (r) + VEX.vvvv (r) + " + instruction vvvv: instruction operand3 index +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMIOperand1: instruction + " + ModRM:reg (w) + VEX.vvvv (r) + ModRM:r/m (r) + imm8[3:0] + " + instruction vreg: instruction operand1 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMIOperand2: instruction + " + ModRM:reg (w) + VEX.vvvv (r) + ModRM:r/m (r) + imm8[3:0] + " + instruction vvvv: instruction operand2 index +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMIOperand3: instruction + " + ModRM:reg (w) + VEX.vvvv (r) + ModRM:r/m (r) + imm8[3:0] + " + instruction vrm: instruction operand3 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMIOperand4: instruction + " + ModRM:reg (w) + VEX.vvvv (r) + ModRM:r/m (r) + imm8[3:0] + " + | op bytes | + op := instruction spec operands at: 4. + bytes := self bytesFor: instruction operand4 value length: op length // 8. + instruction immediate: bytes +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMOperand1: instruction + " + ModRM:reg (w) + VEX.vvvv + ModRM:r/m (r) + " + instruction vreg: instruction operand1 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMOperand2: instruction + " + ModRM:reg (w) + VEX.vvvv + ModRM:r/m (r) + " + instruction vvvv: instruction operand2 index +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMOperand3: instruction + " + ModRM:reg (w) + VEX.vvvv + ModRM:r/m (r) + " + instruction vrm: instruction operand3 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMROperand1: instruction + " + ModRM:reg (w) + VEX.vvvv (r) + ModRM:r/m (r) + imm8[7:4] + " + instruction vreg: instruction operand1 +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMROperand2: instruction + " + ModRM:reg (w) + VEX.vvvv (r) + ModRM:r/m (r) + imm8[7:4] + " + instruction vvvv: instruction operand2 index +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMROperand3: instruction + " + ModRM:reg (w) + VEX.vvvv (r) + ModRM:r/m (r) + imm8[7:4] + " + instruction vrm: instruction operand3 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeRVMROperand4: instruction + " + ModRM:reg (w) + VEX.vvvv (r) + ModRM:r/m (r) + imm8[7:4] + " + | imm | + imm := instruction operand4 index bitShift: 4. + instruction immediate: imm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeT1SOperand1: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeT1SOperand2: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeT1SOperand3: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeT1SRVMOperand1: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeT1SRVMOperand2: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeT1SRVMOperand3: instruction + " + ModRM:reg (w) + EVEX.vvvv + ModRM:r/m (r) + " +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeTDOperand1: operand + " + Moffs (w) + AL/AX/EAX/RAX + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeTDOperand2: operand + " + Moffs (w) + AL/AX/EAX/RAX + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeTOOperand1: operand + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeTOOperand2: operand + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeVMIOperand1: instruction + " + VEX.vvvv (w) + ModRM:r/m (r) + imm8 + " + instruction vvvv: instruction operand1 index +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeVMIOperand2: instruction + " + VEX.vvvv (w) + ModRM:r/m (r) + imm8 + " + instruction vrm: instruction operand2 rm +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeVMIOperand3: instruction + " + VEX.vvvv (w) + ModRM:r/m (r) + imm8 + " + | op bytes | + op := instruction spec operands at: 3. + bytes := self bytesFor: instruction operand3 value length: op length // 8. + instruction immediate: bytes +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeVMOperand1: operand + " + VEX.vvvv (w) + ModRM:r/m (r) + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeVMOperand2: operand + " + VEX.vvvv (w) + ModRM:r/m (r) + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeXMOperand1: operand + " + ModRM:reg (w) + ModRM:r/m (r) + " + +! ! + +!OperandEncoding methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeXMOperand2: operand + " + ModRM:reg (w) + ModRM:r/m (r) + " + +! ! + +!OperandEncoding methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +immediateOperand + ^descriptions findFirst: [:d | d includesString: 'imm'] +! ! + +!OperandEncoding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isImmediate1Operand: index + ^(self isImmediateOperand: index) + and: [(1 to: index - 1) noneSatisfy: [:i | self isImmediateOperand: i]] +! ! + +!OperandEncoding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isImmediate2Operand: index + ^(self isImmediateOperand: index) + and: [(1 to: index - 1) anySatisfy: [:i | self isImmediateOperand: i]] +! ! + +!OperandEncoding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isImmediateOperand: index + | d | + d := descriptions at: index. + ^(d includesString: 'imm') or: [d includesString: 'offs'] or: [d = 'iw'] +! ! + +!OperandEncoding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isVvvvOperand: index + ^(descriptions at: index) includesString: 'vvvv' +! ! + +!OperandEncoding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^name +! ! + +!OperandEncoding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name: aString + name := aString +! ! + +!OperandEncoding methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand: index of: instruction + | d | + d := descriptions at: index. + (d includesString: 'reg') ifTrue: [^instruction regOperand: index]. + (d includesString: 'r/m') ifTrue: [^instruction rmOperand: index]. + (d includesString: 'vvvv') ifTrue: [^instruction vvvvOperand: index]. + (self isImmediate1Operand: index) ifTrue: [^instruction immediateOperand]. + (self isImmediate2Operand: index) ifTrue: [^instruction immediateOperand2]. + (instruction spec operands at: index) isImmediate + ifTrue: [^instruction immediateOperand]. + ((d beginsWith: 'opcode') and: [index = 1]) + ifTrue: [^instruction opcodeOperand]. + self ASSERT: false +! ! + +!OperandEncoding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + name isNil ifTrue: [^super printOn: aStream]. + aStream nextPutAll: name +! ! + +!OperandEncoding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +selectors + ^selectors +! ! + +!OperandEncoding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +selectors: aCollection + selectors := aCollection +! ! + +!OperandEncoding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +usesImmediate + ^immediate +! ! + +!OperandEncoding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +usesImmediate2 + ^immediate and: [selectors anySatisfy: [:s | s includesString: 'II']] +! ! + +!OperandEncoding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +usesModRM + ^modrm +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OperandEncoding class' category: #'Powerlang-Core-Assembler-Intel'! +OperandEncoding class + instanceVariableNames: 'Encodings'! + +!OperandEncoding class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +commentEncodingMethods + " + StChangesetBrowser new + label: 'OperandEncoding comments'; + setModel: (ChangesetBrowserModel on: OperandEncoding commentEncodingMethods); + openInWindow + " + | changes | + changes := OrderedCollection new. + Encodings collect: [:oe | | comment | + comment := String streamContents: [:strm | + strm crtab; nextPut: $"; crtab. + oe descriptions do: [:d | strm nextPutAll: d; crtab]. + strm nextPut: $"; cr]. + oe selectors do: [:s | | cm reader source change | + cm := self >> s. + reader := cm sourceCode readStream. + source := String streamContents: [:strm | + strm + nextPutAll: reader nextLine; + nextPutAll: comment; + nextPutAll: reader upToEnd]. + change := self project changes + methodDefinitionClass: self + sourceCode: source. + changes add: change]]. + ^changes +! ! + +!OperandEncoding class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +defs + ^#( + #('A' 'imm8') + #('D' 'offset') + #('FD' 'AL/AX/EAX/RAX' 'Moffs') + #('FV' 'ModRM:reg (w)' 'EVEX.vvvv' 'ModRM:r/m (r)') + #('FV-RVM' 'ModRM:reg (w)' 'EVEX.vvvv' 'ModRM:r/m (r)') + #('I' 'AL/AX/EAX/RAX' 'imm8') + #('II' 'iw' 'imm8') + #('M' 'ModRM:r/m (r)') + #('M1' 'ModRM:r/m (w)' '1') + #('MC' 'ModRM:r/m (w)' 'CL') + #('MI' 'ModRM:r/m (r, w)' 'imm8') + #('MR' 'ModRM:r/m (r, w)' 'ModRM:reg (r)') + #('MRC' 'ModRM:r/m (w)' 'ModRM:reg (r)' 'CL') + #('MRI' 'ModRM:r/m (w)' 'ModRM:reg (r)' 'imm8') + #('MVR' 'ModRM:r/m (w)' 'VEX.vvvv (r)' 'ModRM:reg (r)') + #('NP' 'ModRM:r/m (w)' 'ModRM:reg (r)') + #('O' 'opcode + rd (r, w)') + #('OI' 'opcode + rd (w)' 'imm8/16/32/64') + #('RM' 'ModRM:reg (r, w)' 'ModRM:r/m (r)') + #('RM0' 'ModRM:reg (r, w)' 'ModRM:r/m (r)') + #('RMI' 'ModRM:reg (w)' 'ModRM:r/m (r)' 'imm8') + #('RMV' 'ModRM:reg (w)' 'ModRM:r/m (r)' 'VEX.vvvv (r)') + #('RVM' 'ModRM:reg (w)' 'VEX.vvvv' 'ModRM:r/m (r)') + #('RVMI' 'ModRM:reg (w)' 'VEX.vvvv (r)' 'ModRM:r/m (r)' 'imm8[3:0]') + #('RVMR' 'ModRM:reg (w)' 'VEX.vvvv (r)' 'ModRM:r/m (r)' 'imm8[7:4]') + #('T1S' 'ModRM:reg (w)' 'EVEX.vvvv' 'ModRM:r/m (r)') + #('T1S-RVM' 'ModRM:reg (w)' 'EVEX.vvvv' 'ModRM:r/m (r)') + #('TD' 'Moffs (w)' 'AL/AX/EAX/RAX') + #('VM' 'VEX.vvvv (w)' 'ModRM:r/m (r)') + #('VMI' 'VEX.vvvv (w)' 'ModRM:r/m (r)' 'imm8') + #('XM' 'ModRM:reg (w)' 'ModRM:r/m (r)')) +! ! + +!OperandEncoding class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeEncodings + Encodings := OrderedCollection new. + self defs + do: [ :def | + | oe n selectors | + n := def first replaceAllSubstrings: '-' with: ''. + oe := self new. + selectors := (2 to: def size) + collect: [ :i | ('encode' , n , 'Operand' , (i - 1) asString , ':') asSymbol ]. + oe + name: n; + selectors: selectors; + descriptions: def allButFirst. + selectors + reject: [ :s | self includesSelector: s ] + thenDo: [ :s | self compile: s , ' instruction' ]. + Encodings add: oe ]. + Encodings := Encodings asArray +! ! + +!OperandEncoding class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +named: aString + ^Encodings + detect: [:e | e name = aString] + ifNone: [(aString includes: $-) ifTrue: [self halt]] +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Parser/AssemblerGrammar.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Parser/AssemblerGrammar.Class.st new file mode 100644 index 00000000..377540b9 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Parser/AssemblerGrammar.Class.st @@ -0,0 +1,213 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #AssemblerGrammar category: #'Powerlang-Core-Assembly-Intel-Parser'! +PPCompositeParser subclass: #AssemblerGrammar + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Parser'! +!AssemblerGrammar commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +base + ^self reg +! ! + +!AssemblerGrammar methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +comma + ^$, asParser trim +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +constant + ^self hex / self decimal +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +decimal + ^#digit asParser plus flatten +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +displacement + ^self operator , self constant +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hex + ^'0x' asParser , #hex asParser plus +! ! + +!AssemblerGrammar methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +imm + ^self immH / self immD +! ! + +!AssemblerGrammar methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +immD + ^self sign , self decimal +! ! + +!AssemblerGrammar methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +immH + ^self hex +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^self sum , self reg +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +instruction + ^self prefix optional , self mnemonic trim , self operands +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +label + ^(self labelName , $: asParser) flatten +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +labelName + ^($@ asParser , #word asParser plus) flatten +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +memory + ^self memorySize optional , $[ asParser trim + , (self segment , ':' asParser) optional + , self sib + , $] asParser trim +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +memorySize + ^'qword' asParser / 'dword' asParser / 'word' asParser / 'bword' asParser + / 'byte' asParser + / 'xmmword' asParser + / 'ymmword' asParser + / 'zmmword' asParser + , 'ptr' asParser trim optional +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mnemonic + ^(#letter asParser , (#letter asParser / #digit asParser) star) flatten +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mul + ^$* asParser trim flatten +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operand + ^self memory / self reg / self imm / self labelName +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands + ^(self operands3 / self operands2 / self operands1) optional +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands1 + ^self operand +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands2 + ^self operand , self comma , self operand +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands3 + ^self operand , self comma , self operand , self comma , self operand +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operator + ^($+ asParser / $- asParser) trim +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefix + ^PPChoiceParser + withAll: (#( 'lock' 'repne' 'repnz' 'repe' 'repz' 'rep') + collect: [:name | name asParser trim]) +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +reg + ^ (PPChoiceParser + withAll: + ((Registers asArray sort: [ :a :b | a name size > b name size ]) + collect: [ :r | r name asParser ])) flatten +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +scale + ^self mul , ($1 asParser / $2 asParser / $4 asParser / $8 asParser) +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +segment + ^'cs' asParser / 'ds' asParser / 'ss' asParser / 'es' asParser + / 'fs' asParser + / 'gs' asParser +! ! + +!AssemblerGrammar methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +separator + ^#blank asParser star flatten +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sib + ^self sib1 / self sib3 / self sib2 +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sib1 + ^self displacement / self constant +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sib2 + ^self base , self index optional , self scale optional + , self displacement optional +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sib3 + ^self reg , self scale , self displacement +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sign + ^($+ asParser / $- asParser) trim optional +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +start + ^self label / self instruction + , (#blank asParser plus flatten , (self label / self instruction)) star +! ! + +!AssemblerGrammar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sum + ^$+ asParser trim flatten +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'AssemblerGrammar class' category: #'Powerlang-Core-Assembly-Intel-Parser'! +AssemblerGrammar class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Parser/AssemblerParser.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Parser/AssemblerParser.Class.st new file mode 100644 index 00000000..8f3794b1 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Parser/AssemblerParser.Class.st @@ -0,0 +1,216 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #AssemblerParser category: #'Powerlang-Core-Assembly-Intel-Parser'! +AssemblerGrammar subclass: #AssemblerParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Parser'! +!AssemblerParser commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +bitLengthOf: anInteger + (anInteger between: -16r80 and: 16r7F) ifTrue: [^8]. + (anInteger between: -16r8000 and: 16r7FFF) ifTrue: [^16]. + (anInteger between: -16r80000000 and: 16r7FFFFFFF) ifTrue: [^32]. + (anInteger between: -16r8000000000000000 and: 16r7FFFFFFFFFFFFFFF) + ifTrue: [^64]. + (anInteger + between: -16r80000000000000000000000000000000 + and: 16r7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF) + ifTrue: [^128]. + ^nil +! ! + +!AssemblerParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +comma + ^super comma ==> [:nodes | ] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +decimal + ^super decimal ==> [:node | node asInteger] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +displacement + ^super displacement + ==> [:nodes | nodes first = $- + ifTrue: [nodes second negated] + ifFalse: [nodes second]] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hex + ^super hex + ==> [:nodes | Integer readFrom: nodes second readStream radix: 16] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +immD + ^super immD ==> [:nodes | | sign value | + sign := nodes first = $- ifTrue: [-1] ifFalse: [1]. + value := nodes second * sign. + ISAImmediate new value: value] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +immH + ^super immH ==> [:value | | s len | + len := self bitLengthOf: value. + s := self signInteger: value. + s < 0 ifTrue: [len := len // 2]. + ISAImmediate new value: s; length: len] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^super index ==> [:nodes | nodes second] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +instruction + ^super instruction ==> [:nodes | + ISAInstruction new + prefix: nodes first; + mnemonic: nodes second; + operands: (nodes third ifNil: #())] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +memory + ^super memory ==> [:nodes | | memory | + memory := nodes fourth. + nodes third ifNotNil: [:seg | memory segment: seg first]. + nodes first ifNotNil: [:len | memory length: len]. + memory] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +memorySize + ^super memorySize ==> [:nodes | | c index | + index := 'bwdqxyz' indexOf: nodes first first. + #(8 16 32 64 128 256 512) at: index] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands + ^super operands ==> [:nodes | | reg | + nodes notNil ifTrue: [ + reg := nodes + detect: [:op | op isInteger not + and: [op isString not] + and: [op isRegister]] + ifNone: nil. + reg notNil ifTrue: [ + nodes + select: [:op | op isInteger not + and: [op isMemory] + and: [op length isNil]] + thenDo: [:op | op length: reg length]]]. + nodes] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands1 + ^super operands1 ==> [:node | {node}] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands2 + ^super operands2 ==> [:nodes | {nodes first. nodes third}] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operands3 + ^super operands3 ==> [:nodes | {nodes first. nodes third. nodes fifth}] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseInstruction: aString + | array | + array := self parse: aString. + ^array anyOne + +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefix + ^super prefix ==> [:name | InstructionPrefix prefixes at: name asUppercase] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +reg + ^super reg ==> [:nodes | Register named: nodes] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +scale + ^super scale ==> [:nodes | nodes second digitValue] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +segment + ^super segment ==> [:nodes | Register named: nodes] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sib1 + ^super sib1 ==> [:node | MemoryOperand new displacement: node] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sib2 + | scale displacement | + ^ super sib2 + ==> [ :nodes | scale := nodes third ifNil: [ 1 ]. + displacement := nodes fourth ifNil: [ 0 ]. + MemoryOperand new + base: nodes first; + index: nodes second; + scale: scale; + displacement: displacement ] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sib3 + ^super sib3 ==> [:nodes | + MemoryOperand new + index: nodes first; + scale: nodes second; + displacement: nodes third] +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +signInteger: anInteger + anInteger < 0 ifTrue: [^anInteger]. + anInteger < 16r80 ifTrue: [^anInteger]. + anInteger < 16r100 ifTrue: [^anInteger - 16r100]. + anInteger < 16r8000 ifTrue: [^anInteger]. + anInteger < 16r10000 ifTrue: [^anInteger - 16r10000]. + anInteger < 16r80000000 ifTrue: [^anInteger]. + anInteger < 16r100000000 ifTrue: [^anInteger - 16r100000000]. + anInteger < 16r8000000000000000 ifTrue: [^anInteger]. + anInteger < 16r10000000000000000 + ifTrue: [^anInteger - 16r10000000000000000]. + ^anInteger +! ! + +!AssemblerParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +start + ^super start ==> [:nodes | | tail | + tail := nodes second collect: [:a | a second]. + Array with: nodes first withAll: tail] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'AssemblerParser class' category: #'Powerlang-Core-Assembly-Intel-Parser'! +AssemblerParser class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Parser/Assembly.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Parser/Assembly.Class.st new file mode 100644 index 00000000..4898d111 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Parser/Assembly.Class.st @@ -0,0 +1,61 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #Assembly category: #'Powerlang-Core-Assembly-Intel-Parser'! +Object subclass: #Assembly + instanceVariableNames: 'labels instructions source parser' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Parser'! +!Assembly commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Assembly methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + labels := Dictionary new. + instructions := OrderedCollection new. + parser := AssemblerParser new +! ! + +!Assembly methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parse + | everything | + everything := parser parse: source. + everything do: [:token | + token isString + ifTrue: [labels at: token allButLast put: instructions size] + ifFalse: [instructions add: token]] +! ! + +!Assembly methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parser: anAssemblerParser + parser := anAssemblerParser +! ! + +!Assembly methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +source: aString + source := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Assembly class' category: #'Powerlang-Core-Assembly-Intel-Parser'! +Assembly class + instanceVariableNames: ''! + +!Assembly class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +new + ^super new initialize +! ! + +!Assembly class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +on: aString + ^self new source: aString +! ! + + +Assembly initialize! + diff --git a/modules/LMR/Nativizer/Assembly/Intel/REXPrefix.Class.st b/modules/LMR/Nativizer/Assembly/Intel/REXPrefix.Class.st new file mode 100644 index 00000000..f606ff87 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/REXPrefix.Class.st @@ -0,0 +1,110 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #REXPrefix category: #'Powerlang-Core-Assembler-Intel'! +InstructionPrefix subclass: #REXPrefix + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!REXPrefix commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!REXPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isRex + ^true +! ! + +!REXPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +matches: anInteger + ^anInteger isOnBit: self value +! ! + +!REXPrefix methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + self == REX_W ifTrue: [^16r48]. + self == REX_R ifTrue: [^16r44]. + self == REX ifTrue: [^16r40]. + self ASSERT: false. + ^nil +! ! + +!REXPrefix methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeOn: instruction + instruction writeRexPrefix: self value +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'REXPrefix class' category: #'Powerlang-Core-Assembler-Intel'! +REXPrefix class + instanceVariableNames: ''! + +!REXPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +b + ^1 +! ! + +!REXPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +fromStream: aStream + | s | + s := aStream upTo: $+. + ^self fromString: s +! ! + +!REXPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +fromString: aString + (aString endsWith: 'REX.W') ifTrue: [^self w]. + (aString endsWith: 'REX.R') ifTrue: [^self r]. + (aString endsWith: 'REX') ifTrue: [^self rex]. + ^nil +! ! + +!REXPrefix class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializePrefixes + #('REX' 'REX_W' 'REX_R') + do: [ :s | + | rex | + rex := self new name: s. + Prefixes at: s put: rex ]. + +! ! + +!REXPrefix class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +peekFrom: aStream + ^(aStream peek bitAnd: 16rF0) = 16r40 ifTrue: [aStream next] +! ! + +!REXPrefix class methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +print: byte on: aStream + self ASSERT: (byte isOnBit: REX value). + aStream nextPutAll: '0100'. + (byte isOnBit: self w value) ifTrue: [aStream nextPut: $w]. + (byte isOnBit: self r) ifTrue: [aStream nextPut: $r]. + (byte isOnBit: self x) ifTrue: [aStream nextPut: $x]. + (byte isOnBit: self b) ifTrue: [aStream nextPut: $b] +! ! + +!REXPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +r + ^REX_R +! ! + +!REXPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +rex + ^REX +! ! + +!REXPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +w + ^REX_W +! ! + +!REXPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +x + ^2 +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Register.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Register.Class.st new file mode 100644 index 00000000..55f367f4 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Register.Class.st @@ -0,0 +1,454 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #Register category: #'Powerlang-Core-Assembler-Intel'! +ISAOperand subclass: #Register + instanceVariableNames: 'name index family flags' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!Register commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Register methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +addFlag: flagBit + flags := flags bitOr: flagBit +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +b + ^family at: 1 +! ! + +!Register methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +byte + ^self b +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +e + ^family at: 3 +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +extensionBit + ^self isExtended ifTrue: [1] ifFalse: [0] +! ! + +!Register methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +family: anArray + family := anArray +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +forLength: reglength + self ASSERT: (#(8 16 32 64) includes: reglength). + + reglength == 8 ifTrue: [ ^ self b ]. + reglength == 16 ifTrue: [ ^ self w ]. + reglength == 32 ifTrue: [ ^ self e ]. + reglength == 64 ifTrue: [ ^ self r ]. + +! ! + +!Register methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +getB + self == rax ifTrue: [^al]. + self == rcx ifTrue: [^cl]. + self == rdx ifTrue: [^dl]. + self == rbx ifTrue: [^bl]. + self == rsi ifTrue: [^sil]. + self == rdi ifTrue: [^dil]. + self == rbp ifTrue: [^bpl]. + self == rsp ifTrue: [^spl]. + self == r8 ifTrue: [^r8b]. + self == r9 ifTrue: [^r9b]. + self == r10 ifTrue: [^r10b]. + self == r11 ifTrue: [^r11b]. + self == r12 ifTrue: [^r12b]. + self == r13 ifTrue: [^r13b]. + self == r14 ifTrue: [^r14b]. + self == r15 ifTrue: [^r15b]. + ^nil +! ! + +!Register methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +getE + self == rax ifTrue: [^eax]. + self == rcx ifTrue: [^ecx]. + self == rdx ifTrue: [^edx]. + self == rbx ifTrue: [^ebx]. + self == rsi ifTrue: [^esi]. + self == rdi ifTrue: [^edi]. + self == rbp ifTrue: [^ebp]. + self == rsp ifTrue: [^esp]. + self == r8 ifTrue: [^r8d]. + self == r9 ifTrue: [^r9d]. + self == r10 ifTrue: [^r10d]. + self == r11 ifTrue: [^r11d]. + self == r12 ifTrue: [^r12d]. + self == r13 ifTrue: [^r13d]. + self == r14 ifTrue: [^r14d]. + self == r15 ifTrue: [^r15d]. + ^nil +! ! + +!Register methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +getW + self == rax ifTrue: [^ax]. + self == rcx ifTrue: [^cx]. + self == rdx ifTrue: [^dx]. + self == rbx ifTrue: [^bx]. + self == rsi ifTrue: [^si]. + self == rdi ifTrue: [^di]. + self == rbp ifTrue: [^bp]. + self == rsp ifTrue: [^sp]. + self == r8 ifTrue: [^r8w]. + self == r9 ifTrue: [^r9w]. + self == r10 ifTrue: [^r10w]. + self == r11 ifTrue: [^r11w]. + self == r12 ifTrue: [^r12w]. + self == r13 ifTrue: [^r13w]. + self == r14 ifTrue: [^r14w]. + self == r15 ifTrue: [^r15w]. + ^nil +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^index +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: anInteger + index := anInteger +! ! + +!Register methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeFamily + (name first = $r and: [length = 64]) ifTrue: [ + family := {self getB. self getW. self getE. self}. + family select: #notNil thenDo: [:reg | reg family: family]] +! ! + +!Register methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeFlags + flags := 0. + self initializeRegisterGroupFlag +! ! + +!Register methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeRegisterGroupFlag + (name includesString: 'mm') ifTrue: [^self addFlag: RegisterSIMD]. + (#('es' 'cs' 'ss' 'ds' 'fs' 'gs') includes: name) + ifTrue: [^self addFlag: RegisterSegment]. + self addFlag: RegisterGP +! ! + +!Register methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCompatibleWith: anOperandType + anOperandType isRegister ifFalse: [^false]. + (anOperandType registerGroup = self registerGroup + and: [length = anOperandType length or: [anOperandType length isNil]]) + ifTrue: [^true]. + ^anOperandType isSpecificRegister and: [name = anOperandType name] +! ! + +!Register methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isExtended + ^index > 7 +! ! + +!Register methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isGeneral + ^self registerGroup = RegisterGP +! ! + +!Register methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLongModeOld8BitRegister + self = spl ifTrue: [^true]. + self = bpl ifTrue: [^true]. + self = sil ifTrue: [^true]. + self = dil ifTrue: [^true]. + ^false +! ! + +!Register methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isRegister + ^true +! ! + +!Register methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSIMD + ^self registerGroup = RegisterSIMD +! ! + +!Register methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSegment + ^self registerGroup = RegisterSegment +! ! + +!Register methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isTemplate + ^true +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +long + ^ family at: 3 +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^name +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name: aString + name := aString asLowercase +! ! + +!Register methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +needsExtraBit + ^self isExtended +! ! + +!Register methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefers: anOperandType to: anotherOperandType + ^anOperandType name = name +! ! + +!Register methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + name isNil ifTrue: [^super printOn: aStream]. + aStream nextPutAll: name +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +r + ^family at: 4 +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +regExtension + ^self extensionBit +! ! + +!Register methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +registerGroup + ^flags bitAnd: RegisterGroupMask +! ! + +!Register methodsFor: 'encoding' stamp: 'KenD 28/Jun/2026 13:27:40'! +rm + ^index +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +short + ^ family at: 2 +! ! + +!Register methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +w + ^family at: 2 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Register class' category: #'Powerlang-Core-Assembler-Intel'! +Register class + instanceVariableNames: ''! + +!Register class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +addRegister: aRegister + Registers at: aRegister name asSymbol put: aRegister +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize16BitRegisters + #('ax' 'cx' 'dx' 'bx' 'sp' 'bp' 'si' 'di' 'r8w' 'r9w' 'r10w' 'r11w' 'r12w' 'r13w' 'r14w' 'r15w') + withIndexDo: [:r :i | | register | + register := self new + name: r; + index: i - 1; + length: 16; + initializeFlags. + self addRegister: register] +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize32BitRegisters + #('eax' 'ecx' 'edx' 'ebx' 'esp' 'ebp' 'esi' 'edi' 'r8d' 'r9d' 'r10d' 'r11d' 'r12d' 'r13d' 'r14d' 'r15d') + withIndexDo: [:r :i | | register | + register := self new + name: r; + index: i - 1; + length: 32; + initializeFlags. + self addRegister: register] +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize64BitRegisters + #('rax' 'rcx' 'rdx' 'rbx' 'rsp' 'rbp' 'rsi' 'rdi' 'r8' 'r9' 'r10' 'r11' 'r12' 'r13' 'r14' 'r15') + withIndexDo: [:r :i | | register | + register := self new + name: r; + index: i - 1; + length: 64; + initializeFlags. + self addRegister: register] +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize8BitRegisters + #('al' 'cl' 'dl' 'bl' 'ah' 'ch' 'dh' 'bh') withIndexDo: [:r :i | | register | + register := Register new + name: r; + index: i - 1; + length: 8; + initializeFlags. + self addRegister: register] +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize8BitRexRegisters + #('spl' 'bpl' 'sil' 'dil' 'r8b' 'r9b' 'r10b' 'r11b' 'r12b' 'r13b' 'r14b' 'r15b') + withIndexDo: [:r :i | | register | + register := self new + name: r; + index: i + 3; + length: 8; + initializeFlags. + self addRegister: register] +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeFamilies + Registers do: [:reg | reg initializeFamily] +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeMMXRegisters + 0 to: 7 do: [:i | | mmx | + mmx := self new + name: 'mmx' , i asString; + index: i; + length: 64; + initializeFlags. + self addRegister: mmx] +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeRIPRegister + | register | + register := self new + name: 'rip'; + index: 5; + length: 64; + initializeFlags. + self addRegister: register +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeRegisters + + self + addNamespaceAs: #Registers; + initialize8BitRegisters; + initialize8BitRexRegisters; + initialize16BitRegisters; + initialize32BitRegisters; + initialize64BitRegisters; + initializeRIPRegister; + initializeMMXRegisters; + initializeSSERegisters; + initializeSegmentRegisters +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeSSERegisters + 0 to: 15 do: [:i | | xmm | + xmm := self new + name: 'xmm' , i asString; + index: i; + length: 128; + initializeFlags. + self addRegister: xmm]. + 0 to: 15 do: [:i | | ymm | + ymm := self new + name: 'ymm' , i asString; + index: i; + length: 256; + initializeFlags. + self addRegister: ymm] +! ! + +!Register class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeSegmentRegisters + #('es' 'cs' 'ss' 'ds' 'fs' 'gs') withIndexDo: [:r :i | | register | + register := self new + name: r; + index: i - 1; + length: 16; + initializeFlags. + self addRegister: register] +! ! + +!Register class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +named: aString + " + Register named: 'rax' + " + ^Registers at: aString asLowercase ifAbsent: nil +! ! + +!Register class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +registers + ^Registers +! ! + +!Register class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +segment: index + index = 0 ifTrue: [^cs]. + index = 1 ifTrue: [^ss]. + index = 2 ifTrue: [^ds]. + index = 3 ifTrue: [^es]. + index = 4 ifTrue: [^fs]. + index = 5 ifTrue: [^gs]. + ^nil +! ! + +!Register class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +withIndex: index length: length + ^Registers detect: [:r | + r index = index + and: [r length = length] + and: [(r name beginsWith: 'mmx') not] + and: [r isSegment not]] +! ! + +!Register class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +withIndex: index length: length long: aBoolean + ^Registers detect: [:r | + r index = index + and: [r length = length] + and: [(r name beginsWith: 'mmx') not] + and: [r isSegment not] + and: [r isLongModeOld8BitRegister ifTrue: [aBoolean] ifFalse: [true]]] +! ! + +!Register class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +xmm: i + ^self named: 'xmm' , i asString +! ! + +!Register class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +ymm: i + ^self named: 'ymm' , i asString +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/SegmentPrefix.Class.st b/modules/LMR/Nativizer/Assembly/Intel/SegmentPrefix.Class.st new file mode 100644 index 00000000..2b0c9876 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/SegmentPrefix.Class.st @@ -0,0 +1,102 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SegmentPrefix category: #'Powerlang-Core-Assembler-Intel'! +InstructionPrefix subclass: #SegmentPrefix + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!SegmentPrefix commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!SegmentPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSegment + ^true +! ! + +!SegmentPrefix methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +register + ^Register named: name allButLast +! ! + +!SegmentPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^value +! ! + +!SegmentPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: aInteger + value := aInteger +! ! + +!SegmentPrefix methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeOn: instruction + instruction writeSegmentPrefix: value +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SegmentPrefix class' category: #'Powerlang-Core-Assembler-Intel'! +SegmentPrefix class + instanceVariableNames: ''! + +!SegmentPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +cs + ^self new name: 'cs:'; value: 16r2E +! ! + +!SegmentPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +ds + ^self new name: 'ds:'; value: 16r3E +! ! + +!SegmentPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +es + ^self new name: 'es:'; value: 16r26 +! ! + +!SegmentPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +fs + ^self new name: 'fs:'; value: 16r64 +! ! + +!SegmentPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +gs + ^self new name: 'gs:'; value: 16r65 +! ! + +!SegmentPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +named: aString + | string char | + aString size < 2 ifTrue: [^nil]. + string := aString asLowercase. + (string at: 2) = $s ifFalse: [^nil]. + char := string at: 1. + char = $c ifTrue: [^self cs]. + char = $s ifTrue: [^self ss]. + char = $d ifTrue: [^self ds]. + char = $e ifTrue: [^self es]. + char = $f ifTrue: [^self fs]. + char = $g ifTrue: [^self gs]. + ^nil +! ! + +!SegmentPrefix class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +peekFrom: aStream + (aStream peekFor: 16r2E) ifTrue: [^self cs]. + (aStream peekFor: 16r3E) ifTrue: [^self ds]. + (aStream peekFor: 16r26) ifTrue: [^self es]. + (aStream peekFor: 16r64) ifTrue: [^self fs]. + (aStream peekFor: 16r65) ifTrue: [^self gs]. + ^nil +! ! + +!SegmentPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +ss + ^self new name: 'ss:'; value: 16r36 +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/SysVX64ABI.Class.st b/modules/LMR/Nativizer/Assembly/Intel/SysVX64ABI.Class.st new file mode 100644 index 00000000..0d3b4096 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/SysVX64ABI.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SysVX64ABI category: #'Powerlang-Core-Assembler-Intel'! +X64ABI subclass: #SysVX64ABI + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!SysVX64ABI methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitEntrypoint: anFFIDescriptor with: anAssembler + anAssembler saveCallerFrame; + pushG; + pushNil; + pushTrue; + pushFalse; + pushM. + self storeArgumentsInStack: anFFIDescriptor with: anAssembler. + +! ! + +!SysVX64ABI methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +popRetaddrAndArgs: anFFIDescriptor with: anAssembler + anAssembler + popA; + popA; + popA +! ! + +!SysVX64ABI methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreContext: anFFIDescriptor with: anAssembler + self popRetaddrAndArgs: anFFIDescriptor with: anAssembler. + anAssembler + popM; + popFalse; + popTrue; + popNil; + popG; + popFP; + return +! ! + +!SysVX64ABI methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeArgumentsInStack: anFFIDescriptor with: anAssembler + anAssembler pushS; + loadRwithArgPointer; + convertRtoSmallInteger; + pushR +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SysVX64ABI class' category: #'Powerlang-Core-Assembler-Intel'! +SysVX64ABI class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAInstructionPartReader.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAInstructionPartReader.Class.st new file mode 100644 index 00000000..8616babd --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAInstructionPartReader.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ISAInstructionPartReader category: #'Powerlang-Core-Assembly-Intel-Tools'! +Object subclass: #ISAInstructionPartReader + instanceVariableNames: 'contents' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Tools'! +!ISAInstructionPartReader commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ISAInstructionPartReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +contents + ^contents contents +! ! + +!ISAInstructionPartReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +from: aStream + contents := #[] writeStream +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ISAInstructionPartReader class' category: #'Powerlang-Core-Assembly-Intel-Tools'! +ISAInstructionPartReader class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAInstructionReader.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAInstructionReader.Class.st new file mode 100644 index 00000000..d9c8077c --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAInstructionReader.Class.st @@ -0,0 +1,93 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ISAInstructionReader category: #'Powerlang-Core-Assembly-Intel-Tools'! +Object subclass: #ISAInstructionReader + instanceVariableNames: 'prefixes opcode modrm sib displacement immediate' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Tools'! +!ISAInstructionReader commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ISAInstructionReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +displacementFrom: aStream + +! ! + +!ISAInstructionReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +from: aStream + self + prefixesFrom: aStream; + opcodeFrom: aStream; + modrmFrom: aStream; + sibFrom: aStream; + displacementFrom: aStream; + immediateFrom: aStream +! ! + +!ISAInstructionReader methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasSib + ^modrm notNil and: [modrm mod = 0] +! ! + +!ISAInstructionReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +immediateFrom: aStream + immediate := aStream upToEnd +! ! + +!ISAInstructionReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +modrmFrom: aStream + modrm := ISAModRMReader new from: aStream; contents +! ! + +!ISAInstructionReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +opcodeFrom: aStream + opcode := ISAOpcodeReader new from: aStream; asString +! ! + +!ISAInstructionReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +prefixesFrom: aStream + prefixes := ISAPrefixReader new from: aStream; asString +! ! + +!ISAInstructionReader methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + aStream nextPutAll: prefixes. + prefixes size > 0 ifTrue: [aStream nextPutAll: '| ']. + aStream nextPutAll: opcode. + aStream nextPutAll: ' | '. + modrm notNil ifTrue: [modrm printOn: aStream]. + sib notNil ifTrue: [ + aStream nextPutAll: ' | '. + sib printOn: aStream]. + displacement notNil ifTrue: [ + aStream nextPutAll: ' |'. + displacement do: [:byte | | hex | + hex := byte hex. + hex size = 1 ifTrue: [hex := '0' , hex]. + aStream space; nextPutAll: hex]]. + immediate notNil ifTrue: [ + aStream nextPutAll: ' |'. + immediate do: [:byte | | hex | + hex := byte hex. + hex size = 1 ifTrue: [hex := '0' , hex]. + aStream space; nextPutAll: hex]] +! ! + +!ISAInstructionReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +sibFrom: aStream + self hasSib ifFalse: [^self]. + aStream atEnd ifTrue: [^self]. + sib := ISASibReader new from: aStream; contents +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ISAInstructionReader class' category: #'Powerlang-Core-Assembly-Intel-Tools'! +ISAInstructionReader class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAModRMReader.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAModRMReader.Class.st new file mode 100644 index 00000000..4b504ef8 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAModRMReader.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ISAModRMReader category: #'Powerlang-Core-Assembly-Intel-Tools'! +ISAInstructionPartReader subclass: #ISAModRMReader + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Tools'! +!ISAModRMReader commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ISAModRMReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +contents + ^contents +! ! + +!ISAModRMReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +from: aStream + contents := aStream atEnd ifFalse: [ModRM new on: aStream next] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ISAModRMReader class' category: #'Powerlang-Core-Assembly-Intel-Tools'! +ISAModRMReader class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAOpcodeReader.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAOpcodeReader.Class.st new file mode 100644 index 00000000..842e1ce6 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAOpcodeReader.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ISAOpcodeReader category: #'Powerlang-Core-Assembly-Intel-Tools'! +ISAInstructionPartReader subclass: #ISAOpcodeReader + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Tools'! +!ISAOpcodeReader commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ISAOpcodeReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +from: aStream + | byte octets | + super from: aStream. + byte := aStream next. + contents nextPut: byte. + byte = 16rF ifTrue: [ + octets := (#[16r66 16rF2 16rF3] includes: contents contents first) + ifTrue: [aStream next: 2] + ifFalse: [{aStream next}]. + contents nextPutAll: octets] +! ! + +!ISAOpcodeReader methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + contents contents + do: [:byte | aStream nextPutAll: byte hex] + separatedBy: [aStream nextPut: $.] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ISAOpcodeReader class' category: #'Powerlang-Core-Assembly-Intel-Tools'! +ISAOpcodeReader class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAPrefixReader.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAPrefixReader.Class.st new file mode 100644 index 00000000..5c90cb63 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISAPrefixReader.Class.st @@ -0,0 +1,135 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ISAPrefixReader category: #'Powerlang-Core-Assembly-Intel-Tools'! +ISAInstructionPartReader subclass: #ISAPrefixReader + instanceVariableNames: 'legacy rex vex' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Tools'! +!ISAPrefixReader commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ISAPrefixReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +from: aStream + super from: aStream. + self + legacyFrom: aStream; + rexFrom: aStream; + vexFrom: aStream +! ! + +!ISAPrefixReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +legacyFrom: aStream + | prefix | + legacy := #() writeStream. + [ + prefix := LegacyPrefix withValue: aStream peek. + prefix isNil] + whileFalse: [ + legacy nextPut: prefix. + contents nextPut: aStream next] +! ! + +!ISAPrefixReader methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printLegacyOn: aStream + legacy contents + do: [:p | aStream nextPutAll: p asString] + separatedBy: [aStream space] +! ! + +!ISAPrefixReader methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + self printLegacyOn: aStream. + legacy size > 0 ifTrue: [aStream space]. + rex notNil ifTrue: [ + self printRexOn: aStream. + aStream space]. + vex notNil ifTrue: [self printVexOn: aStream] +! ! + +!ISAPrefixReader methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printRexOn: aStream + rex isNil ifTrue: [^self]. + aStream nextPutAll: REXPrefix rex asString. + (rex isOnBit: REXPrefix w value) ifTrue: [aStream nextPutAll: '.W']. + (rex isOnBit: REXPrefix r value) ifTrue: [aStream nextPutAll: '.R']. + (rex isOnBit: 1) ifTrue: [aStream nextPutAll: '.B']. + (rex isOnBit: 2) ifTrue: [aStream nextPutAll: '.X'] +! ! + +!ISAPrefixReader methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printVex2On: aStream + self printVexVvvvLpp: vex second on: aStream +! ! + +!ISAPrefixReader methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printVex3On: aStream + | byte x b mmmmm w | + byte := vex second. + x := (byte bitAnd: 2r1000000) > 0 ifTrue: [$1] ifFalse: [$0]. + aStream nextPut: x; nextPut: $.. + b := (byte bitAnd: 2r100000) > 0 ifTrue: [$1] ifFalse: [$0]. + aStream nextPut: b; nextPut: $.. + mmmmm := byte bitAnd: 2r11111. + aStream + nextPutAll: (mmmmm bin: 5); + nextPut: $|. + byte := vex third. + w := byte >= 16r80 ifTrue: [$1] ifFalse: [$0]. + aStream nextPut: w; nextPut: $.. + self printVexVvvvLpp: byte on: aStream +! ! + +!ISAPrefixReader methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printVexOn: aStream + | byte r | + vex isNil ifTrue: [^self]. + aStream nextPutAll: vex first hex; nextPut: $|. + byte := vex second. + r := byte // 16r80 > 0 ifTrue: [$1] ifFalse: [$0]. + aStream nextPut: r; nextPut: $.. + vex size = 2 + ifTrue: [self printVex2On: aStream] + ifFalse: [self printVex3On: aStream] +! ! + +!ISAPrefixReader methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printVexVvvvLpp: byte on: aStream + | vvvv l pp | + vvvv := (byte bitShift: -3) bitAnd: 2r1111. + aStream + nextPutAll: (vvvv bin: 4); + nextPut: $.. + l := (byte bitAnd: 2r100) > 0 ifTrue: [$1] ifFalse: [$0]. + aStream nextPut: l; nextPut: $.. + pp := byte bitAnd: 2r11. + aStream nextPutAll: (pp bin: 2) +! ! + +!ISAPrefixReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +rexFrom: aStream + (aStream peek bitAnd: 16rF0) = REXPrefix rex value ifTrue: [ + rex := aStream next. + contents nextPut: rex] +! ! + +!ISAPrefixReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +vexFrom: aStream + | byte | + byte := aStream peek. + vex := byte = 16rC4 ifTrue: [aStream next: 3] ifFalse: [ + byte = 16rC5 ifFalse: [^self]. + aStream next: 2]. + contents nextPutAll: vex +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ISAPrefixReader class' category: #'Powerlang-Core-Assembly-Intel-Tools'! +ISAPrefixReader class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Tools/ISASibReader.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISASibReader.Class.st new file mode 100644 index 00000000..f99a1b8b --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Tools/ISASibReader.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ISASibReader category: #'Powerlang-Core-Assembly-Intel-Tools'! +ISAInstructionPartReader subclass: #ISASibReader + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Tools'! +!ISASibReader commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ISASibReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +contents + ^contents +! ! + +!ISASibReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +from: aStream + contents := SIB new on: aStream next +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ISASibReader class' category: #'Powerlang-Core-Assembly-Intel-Tools'! +ISASibReader class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Tools/ModRM.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Tools/ModRM.Class.st new file mode 100644 index 00000000..fe6a4eae --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Tools/ModRM.Class.st @@ -0,0 +1,85 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #ModRM category: #'Powerlang-Core-Assembly-Intel-Tools'! +OctalStructure subclass: #ModRM + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Tools'! +!ModRM commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ModRM methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +beRR + self mod: 2r11 +! ! + +!ModRM methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + byte := 0 +! ! + +!ModRM methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mod + ^self hi +! ! + +!ModRM methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mod: anInteger + self hi: anInteger +! ! + +!ModRM methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +opcode + ^self reg +! ! + +!ModRM methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +opcode: anInteger + self reg: anInteger +! ! + +!ModRM methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +reg + ^self mid +! ! + +!ModRM methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +reg: aRegister + | mid | + mid := aRegister isInteger + ifTrue: [aRegister] + ifFalse: [aRegister index \\ 8]. + self mid: mid +! ! + +!ModRM methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +rm + ^self lo +! ! + +!ModRM methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +rm: anInteger + self lo: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ModRM class' category: #'Powerlang-Core-Assembly-Intel-Tools'! +ModRM class + instanceVariableNames: ''! + +!ModRM class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +new + "return an initialized instance" + + ^ self basicNew initialize. + +! ! + + +ModRM initialize! + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Tools/OctalStructure.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Tools/OctalStructure.Class.st new file mode 100644 index 00000000..9c308c7c --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Tools/OctalStructure.Class.st @@ -0,0 +1,87 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #OctalStructure category: #'Powerlang-Core-Assembly-Intel-Tools'! +Object subclass: #OctalStructure + instanceVariableNames: 'byte' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Tools'! +!OctalStructure commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OctalStructure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hi + ^byte bitShift: -6 +! ! + +!OctalStructure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hi: anInteger + | bits | + self ASSERT: anInteger < 4. + bits := anInteger bitShift: 6. + byte := (byte bitAnd: 2r111111) bitOr: bits +! ! + +!OctalStructure methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +lo + ^byte bitAnd: 7 +! ! + +!OctalStructure methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +lo: anInteger + self ASSERT: anInteger < 8. + byte := (byte bitAnd: 2r11111000) bitOr: anInteger +! ! + +!OctalStructure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mid + ^(byte bitShift: -3) bitAnd: 7 +! ! + +!OctalStructure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mid: anInteger + | bits | + self ASSERT: anInteger < 8. + bits := anInteger bitShift: 3. + byte := (byte bitAnd: 2r11000111) bitOr: bits +! ! + +!OctalStructure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +on: anInteger + byte := anInteger +! ! + +!OctalStructure methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + | hi mid lo | + hi := self hi printPaddedWith: $0 to: 2 base: 2. + mid := self mid printPaddedWith: $0 to: 3 base: 2. + lo := self lo printPaddedWith: $0 to: 3 base: 2. + aStream + nextPutAll: hi; + nextPut: $.; + nextPutAll: mid; + nextPut: $.; + nextPutAll: lo +! ! + +!OctalStructure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^byte +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OctalStructure class' category: #'Powerlang-Core-Assembly-Intel-Tools'! +OctalStructure class + instanceVariableNames: ''! + +!OctalStructure class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +new + ^super new initialize +! ! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/Tools/SIB.Class.st b/modules/LMR/Nativizer/Assembly/Intel/Tools/SIB.Class.st new file mode 100644 index 00000000..a8fcad59 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/Tools/SIB.Class.st @@ -0,0 +1,68 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #SIB category: #'Powerlang-Core-Assembly-Intel-Tools'! +OctalStructure subclass: #SIB + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly-Intel-Tools'! +!SIB commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!SIB methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +base + ^self lo +! ! + +!SIB methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +base: anInteger + self lo: anInteger +! ! + +!SIB methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +baseRegister: aRegister + self base: aRegister index +! ! + +!SIB methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^self mid +! ! + +!SIB methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: anInteger + self mid: anInteger +! ! + +!SIB methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +indexRegister: aRegister + self index: aRegister index +! ! + +!SIB methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +scale + ^self hi +! ! + +!SIB methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +scale: anInteger + self hi: anInteger +! ! + +!SIB methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +scaleFactor: s + | index | + index := #[1 2 4 8] indexOf: s. + self scale: index - 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SIB class' category: #'Powerlang-Core-Assembly-Intel-Tools'! +SIB class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/VEXPrefix.Class.st b/modules/LMR/Nativizer/Assembly/Intel/VEXPrefix.Class.st new file mode 100644 index 00000000..9b0fd3c7 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/VEXPrefix.Class.st @@ -0,0 +1,304 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #VEXPrefix category: #'Powerlang-Core-Assembler-Intel'! +InstructionPrefix subclass: #VEXPrefix + instanceVariableNames: 'signature' + classVariableNames: 'Signatures' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!VEXPrefix commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!VEXPrefix methodsFor: 'input' stamp: 'KenD 28/Jun/2026 13:27:40'! +fromStream: aStream + | stream | + stream := (aStream upTo: Space) readStream. + signature := Array streamContents: [:strm | + [stream atEnd] whileFalse: [| part | + part := stream upTo: $.. + strm nextPut: part]] +! ! + +!VEXPrefix methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + name = 'VEX' +! ! + +!VEXPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isVex + ^true +! ! + +!VEXPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +length + signature first = 16rC5 ifTrue: [^16]. + ^24 +! ! + +!VEXPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +matches: aByteArray + | size last mmmmm | + (self mayMatchSize: aByteArray) ifFalse: [^false]. + size := aByteArray size. + last := aByteArray at: size. + (signature includes: 'LIG') + ifFalse: [(signature includes: '256') = (last isOnBit: self class l) + ifFalse: [^false]]. + (signature includes: '66') = (last isOnBit: 2r1) ifFalse: [^false]. + (signature includes: 'F2') = (last isOnBit: 2r10) ifFalse: [^false]. + (signature includes: 'F3') = (last isOnBit: 2r11) ifFalse: [^false]. + (signature includes: 'WIG') + ifFalse: [(signature includes: 'W1') = (last isOnBit: self class w) + ifFalse: [^false]]. + size = 3 ifTrue: [ + mmmmm := (aByteArray at: 2) bitAnd: 2r11111. + (signature includes: '0F') = (mmmmm = 1) ifFalse: [^false]. + (signature includes: '0F38') = (mmmmm = 2r10) ifFalse: [^false]. + (signature includes: '0F3A') = (mmmmm = 2r11) ifFalse: [^false]]. + ^true +! ! + +!VEXPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +mayMatchSize: aByteArray + | n | + n := aByteArray first = 16rC4 ifTrue: [3] ifFalse: [2]. + ((signature includes: 'WIG') or: [signature includes: 'W0']) ifFalse: [^n + = 3]. + (signature includes: 'W1') ifTrue: [^n = 3]. + (signature includes: '0F3A') ifTrue: [^n = 3]. + (signature includes: '0F38') ifTrue: [^n = 3]. + ^true +! ! + +!VEXPrefix methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +operandSize + (signature includes: '128') ifTrue: [^128]. + (signature includes: '256') ifTrue: [^256]. + ^nil +! ! + +!VEXPrefix methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +overridesOperandSize + ^signature includes: '66' +! ! + +!VEXPrefix methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + signature isNil ifTrue: [^super printOn: aStream]. + signature + do: [:s | aStream nextPutAll: s] + separatedBy: [aStream nextPut: $.] +! ! + +!VEXPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +signature + ^signature +! ! + +!VEXPrefix methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +signature: anArray + signature := anArray +! ! + +!VEXPrefix methodsFor: 'isEvaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +sizeFor: instruction + | encoding | + ((signature includes: 'WIG') or: [signature includes: 'W0']) ifFalse: [^3]. + (signature includes: 'W1') ifTrue: [^3]. + (signature includes: '0F3A') ifTrue: [^3]. + (signature includes: '0F38') ifTrue: [^3]. + instruction hasSib ifTrue: [^3]. + encoding := instruction spec operandEncoding. + instruction operands withIndexDo: [:op :i | + op isMemory + ifTrue: [(op baseExtension = 0 or: [op indexExtension = 0]) ifTrue: [^3]] + ifFalse: [ + (op isRegister and: [op index > 7] andNot: [encoding isVvvvOperand: i]) + ifTrue: [^3]]]. + ^2 +! ! + +!VEXPrefix methodsFor: 'isEvaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +valueFor: instruction + | size bytes last | + size := self sizeFor: instruction. + bytes := ByteArray new: size. + size = 2 ifTrue: [bytes at: 1 put: 16rC5] ifFalse: [bytes at: 1 put: 16rC4]. + last := 0. + (signature includes: '256') + ifTrue: [bytes at: size put: (bytes last bitOr: self class l)]. + (signature includes: '66') + ifTrue: [last := bytes at: size put: (last bitOr: 2r1)]. + (signature includes: 'F2') + ifTrue: [last := bytes at: size put: (last bitOr: 2r10)]. + (signature includes: 'F3') + ifTrue: [last := bytes at: size put: (last bitOr: 2r11)]. + (signature includes: 'W1') + ifTrue: [last := bytes at: size put: (last bitOr: self class w)]. + (size = 3 and: [signature includes: '0F']) ifTrue: [bytes at: 2 put: 1]. + (signature includes: '0F38') ifTrue: [bytes at: 2 put: 2r10]. + (signature includes: '0F3A') ifTrue: [bytes at: 2 put: 2r11]. + ^bytes +! ! + +!VEXPrefix methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeOn: instruction + | value | + value := self valueFor: instruction. + instruction writeVexPrefix: value +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'VEXPrefix class' category: #'Powerlang-Core-Assembler-Intel'! +VEXPrefix class + instanceVariableNames: 'Signatures'! + +!VEXPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +b + ^16r20 +! ! + +!VEXPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +fromStream: aStream + ^self withSignature: (aStream upTo: Character space) +! ! + +!VEXPrefix class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeSignatures + Signatures isNil + ifTrue: [ Signatures := Dictionary new ]. + 'VEX.128.0F.WIG + VEX.128.66.0F.W0 + VEX.128.66.0F.W1 + VEX.128.66.0F.WIG + VEX.128.66.0F38.W0 + VEX.128.66.0F38.WIG + VEX.128.66.0F3A.W0 + VEX.128.66.0F3A.W1 + VEX.128.66.0F3A.WIG + VEX.128.F2.0F.WIG + VEX.128.F3.0F.WIG + VEX.256.0F.WIG + VEX.256.66.0F.WIG + VEX.256.66.0F38.W0 + VEX.256.66.0F38.WIG + VEX.256.66.0F3A.W0 + VEX.256.66.0F3A.W1 + VEX.256.66.0F3A.WIG + VEX.256.F2.0F.WIG + VEX.256.F3.0F.WIG + VEX.DDS.128.66.0F38.W0 + VEX.DDS.128.66.0F38.W1 + VEX.DDS.256.66.0F38.0 + VEX.DDS.256.66.0F38.W0 + VEX.DDS.256.66.0F38.W1 + VEX.DDS.LIG.128.66.0F38.W0 + VEX.DDS.LIG.128.66.0F38.W1 + VEX.LIG.0F.WIG + VEX.LIG.66.0F.WIG + VEX.LIG.F2.0F.W0 + VEX.LIG.F2.0F.W1 + VEX.LIG.F2.0F.WIG + VEX.LIG.F3.0F.W0 + VEX.LIG.F3.0F.W1 + VEX.LIG.F3.0F.WIG + VEX.LZ.0F.WIG + VEX.LZ.F2.0F3A.W0 + VEX.LZ.F2.0F3A.W1 + VEX.NDD.128.66.0F.WIG + VEX.NDD.256.66.0F.WIG + VEX.NDD.LZ.0F38.W0 + VEX.NDD.LZ.0F38.W1 + VEX.NDD.LZ.F2.0F38.W0 + VEX.NDD.LZ.F2.0F38.W1 + VEX.NDS.128.0F.WIG + VEX.NDS.128.66.0F.W0 + VEX.NDS.128.66.0F.WIG + VEX.NDS.128.66.0F38.W0 + VEX.NDS.128.66.0F38.W1 + VEX.NDS.128.66.0F38.WIG + VEX.NDS.128.66.0F3A.W0 + VEX.NDS.128.66.0F3A.W1 + VEX.NDS.128.66.0F3A.WIG + VEX.NDS.128.F2.0F.WIG + VEX.NDS.256.0F.WIG + VEX.NDS.256.66.0F.WIG + VEX.NDS.256.66.0F38.W0 + VEX.NDS.256.66.0F38.W1 + VEX.NDS.256.66.0F38.WIG + VEX.NDS.256.66.0F3A.W0 + VEX.NDS.256.66.0F3A.WIG + VEX.NDS.256.F2.0F.WIG + VEX.NDS.LIG.66.0F3A.WIG + VEX.NDS.LIG.F2.0F.W0 + VEX.NDS.LIG.F2.0F.W1 + VEX.NDS.LIG.F2.0F.WIG + VEX.NDS.LIG.F3.0F.W0 + VEX.NDS.LIG.F3.0F.W1 + VEX.NDS.LIG.F3.0F.WIG + VEX.NDS.LZ.0F38.W0 + VEX.NDS.LZ.0F38.W1 + VEX.NDS.LZ.66.0F38.W0 + VEX.NDS.LZ.66.0F38.W1 + VEX.NDS.LZ.F2.0F38.W0 + VEX.NDS.LZ.F2.0F38.W1 + VEX.NDS.LZ.F3.0F38.W0 + VEX.NDS.LZ.F3.0F38.W1 + VEX128.66.0F.WIG' lines + do: [ :line | + | s vex | + s := line trimBlanks. + vex := self new signature: ($. split: s). + Signatures at: s put: vex ] +! ! + +!VEXPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +l + ^2r100 +! ! + +!VEXPrefix class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +operandSizeOverrideBits + ^1 +! ! + +!VEXPrefix class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +peekFrom: aStream + aStream peek = 16rC4 ifTrue: [^aStream next: 3]. + aStream peek = 16rC5 ifTrue: [^aStream next: 2]. + ^nil +! ! + +!VEXPrefix class methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +print: byte on: stream + stream nextPutAll: byte hex +! ! + +!VEXPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +r + ^16r80 +! ! + +!VEXPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +w + ^16r80 +! ! + +!VEXPrefix class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +withSignature: aString + ^Signatures at: aString +! ! + +!VEXPrefix class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +x + ^16r40 +! ! + + +VEXPrefix initialize! + diff --git a/modules/LMR/Nativizer/Assembly/Intel/WinX64ABI.Class.st b/modules/LMR/Nativizer/Assembly/Intel/WinX64ABI.Class.st new file mode 100644 index 00000000..4061a39e --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/WinX64ABI.Class.st @@ -0,0 +1,60 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #WinX64ABI category: #'Powerlang-Core-Assembler-Intel'! +X64ABI subclass: #WinX64ABI + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembler-Intel'! +!WinX64ABI methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitEntrypoint: anFFIDescriptor with: anAssembler + anAssembler saveCallerFrame; + pushG; + pushNil; + pushTrue; + pushFalse; + pushM; + pushE; + pushS. + self storeArgumentsInStack: anFFIDescriptor with: anAssembler. + +! ! + +!WinX64ABI methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +popRetaddrAndArgs: anFFIDescriptor with: anAssembler + anAssembler + popA; + popA; + popA +! ! + +!WinX64ABI methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +restoreContext: anFFIDescriptor with: anAssembler + self popRetaddrAndArgs: anFFIDescriptor with: anAssembler. + anAssembler + popS; + popE; + popM; + popFalse; + popTrue; + popNil; + popG; + popFP; + return +! ! + +!WinX64ABI methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeArgumentsInStack: anFFIDescriptor with: anAssembler + anAssembler pushS; + loadRwithArgPointer; + convertRtoSmallInteger; + pushR +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WinX64ABI class' category: #'Powerlang-Core-Assembler-Intel'! +WinX64ABI class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/X64ABI.Class.st b/modules/LMR/Nativizer/Assembly/Intel/X64ABI.Class.st new file mode 100644 index 00000000..17b9b789 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/X64ABI.Class.st @@ -0,0 +1,121 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #X64ABI category: #'Powerlang-Core-Assembler-Intel'! +ABI subclass: #X64ABI + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: 'Registers' + category: 'Powerlang-Core-Assembler-Intel'! +!X64ABI commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!X64ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +bits + ^64 +! ! + +!X64ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +newAssembler + ^AMD64TemplateAssembler new +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regA + ^rdx +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regE + ^rdi +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFP + ^rbp +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFalse + ^ r14 +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regG + ^r15 +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regIP + ^ rip +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regM + ^rbx +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regNil + ^ r12 +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regR + ^rax +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regS + ^rsi +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regSP + ^rsp +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regT + ^rcx +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regTrue + ^ r13 +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regV + ^r11 +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regX0 + ^xmm0 +! ! + +!X64ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026 13:27:40'! +regX1 + ^xmm1 +! ! + +!X64ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSize + ^8 +! ! + +!X64ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSizeShift + ^3 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'X64ABI class' category: #'Powerlang-Core-Assembler-Intel'! +X64ABI class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/Intel/X86ABI.Class.st b/modules/LMR/Nativizer/Assembly/Intel/X86ABI.Class.st new file mode 100644 index 00000000..bb51d6e3 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/Intel/X86ABI.Class.st @@ -0,0 +1,71 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #X86ABI category: #'Powerlang-Core-Assembler-Intel'! +ABI subclass: #X86ABI + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: 'Registers' + category: 'Powerlang-Core-Assembler-Intel'! +!X86ABI commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!X86ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +bits + ^32 +! ! + +!X86ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +regA + ^edx +! ! + +!X86ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +regE + ^edi +! ! + +!X86ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +regFP + ^ebp +! ! + +!X86ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +regR + ^eax +! ! + +!X86ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +regS + ^esi +! ! + +!X86ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +regSP + ^esp +! ! + +!X86ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +regT + ^ecx +! ! + +!X86ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSize + ^4 +! ! + +!X86ABI methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSizeShift + ^2 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'X86ABI class' category: #'Powerlang-Core-Assembler-Intel'! +X86ABI class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/NativeCodeReference.Class.st b/modules/LMR/Nativizer/Assembly/NativeCodeReference.Class.st new file mode 100644 index 00000000..ab56361c --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/NativeCodeReference.Class.st @@ -0,0 +1,85 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #NativeCodeReference category: #'Powerlang-Core-Assembly'! +Object subclass: #NativeCodeReference + instanceVariableNames: 'source sourceOffset target absolute' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beAbsolute + absolute := true +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +classBinding + ^source classBinding +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +for: anObject + self target: anObject +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + absolute := false +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isAbsolute + ^absolute +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + aStream nextPutAll: 'Ref to '; print: target +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +source: sourceObject + source := sourceObject +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sourceOffset + ^sourceOffset +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sourceOffset: aNumber + sourceOffset := aNumber +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +target + ^target +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +target: anObject + target := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NativeCodeReference class' category: #'Powerlang-Core-Assembly'! +NativeCodeReference class + instanceVariableNames: ''! + +!NativeCodeReference class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +absoluteFor: anObject + ^(self new for: anObject) beAbsolute +! ! + +!NativeCodeReference class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +new + "return an initialized instance" + + ^ self basicNew initialize. + +! ! + + +NativeCodeReference initialize! + diff --git a/modules/LMR/Nativizer/Assembly/RISCCodeGenerator.Class.st b/modules/LMR/Nativizer/Assembly/RISCCodeGenerator.Class.st new file mode 100644 index 00000000..624d457e --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/RISCCodeGenerator.Class.st @@ -0,0 +1,73 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #RISCCodeGenerator category: #'Powerlang-Core-Assembly'! +CodeGenerator subclass: #RISCCodeGenerator + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +clearHigh32: srcAndDstReg + self + shiftLeft: srcAndDstReg byImm: 32; + shiftRight: srcAndDstReg byImm: 32 +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +dec: srcAndDstReg + self addImm: -1 to: srcAndDstReg + +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +decMem: aMemRef + self addImm: -1 toMem: aMemRef + +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +inc: srcAndDstReg + self addImm: 1 to: srcAndDstReg + +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +pop: srcReg + | memref | + memref := self memRef base: self regSP. + self + load: srcReg fromMem: memref; + addImm: wordSize to: self regSP +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +push: srcReg + | memref | + memref := self memRef base: self regSP; displacement: -8. + self + store: srcReg intoMem: memref; + subImm: wordSize from: self regSP +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushImm: imm + | memref | + memref := self memRef base: self regSP; displacement: -8. + self moveImm: imm to: self regV; + store: self regV intoMem: memref; + subImm: wordSize from: self regSP +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026 13:27:40'! +subImm: anInteger from: srcAndDstReg + self addImm: anInteger negated to: srcAndDstReg + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RISCCodeGenerator class' category: #'Powerlang-Core-Assembly'! +RISCCodeGenerator class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/RISCV/RV64CodeGenerator.Class.st b/modules/LMR/Nativizer/Assembly/RISCV/RV64CodeGenerator.Class.st new file mode 100644 index 00000000..9f16eb0f --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/RISCV/RV64CodeGenerator.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #RV64CodeGenerator category: #'Assembly-RISCV'! +RISCCodeGenerator subclass: #RV64CodeGenerator + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: 'RegistersRISCV' + category: 'Assembly-RISCV'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RV64CodeGenerator class' category: #'Assembly-RISCV'! +RV64CodeGenerator class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/RISCV/RegistersRISCV.Class.st b/modules/LMR/Nativizer/Assembly/RISCV/RegistersRISCV.Class.st new file mode 100644 index 00000000..24ea9a38 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/RISCV/RegistersRISCV.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #RegistersRISCV category: #'Assembly-RISCV'! +SharedPool subclass: #RegistersRISCV + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Assembly-RISCV'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RegistersRISCV class' category: #'Assembly-RISCV'! +RegistersRISCV class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/Assembly/RelocatableBuffer.Class.st b/modules/LMR/Nativizer/Assembly/RelocatableBuffer.Class.st new file mode 100644 index 00000000..d28750e7 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/RelocatableBuffer.Class.st @@ -0,0 +1,192 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #RelocatableBuffer category: #'Powerlang-Core-Assembly'! +Object subclass: #RelocatableBuffer + instanceVariableNames: 'stream address fixups' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!RelocatableBuffer commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!RelocatableBuffer methodsFor: 'fixups' stamp: 'KenD 28/Jun/2026 13:27:40'! +addAbsoluteFixup: label + | fixup | + fixup := RelocationFixup absoluteFrom: self currentAddress to: label. + fixups add: fixup +! ! + +!RelocatableBuffer methodsFor: 'fixups' stamp: 'KenD 28/Jun/2026 13:27:40'! +addRelativeFixup: label size: n + | fixup | + fixup := RelocationFixup relativeFrom: self currentAddress to: label. + fixup size: n. + fixups add: fixup +! ! + +!RelocatableBuffer methodsFor: 'fixups' stamp: 'KenD 28/Jun/2026 13:27:40'! +applyFixupsWith: solver + fixups do: [:fixup | fixup patch: self with: solver] +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +baseAddress + ^address +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +bytes + ^stream contents +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +codeSize + ^stream size +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +currentAddress + ^address + stream position +! ! + +!RelocatableBuffer methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + fixups := OrderedCollection new. + address := 0. + stream := #[] writeStream +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBytePut: byte + | value | + value := byte < 0 ifTrue: [ byte + 256 ] ifFalse: byte. + stream nextBytePut: value +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBytesPut: aByteArray + stream nextBytesPut: aByteArray +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextLargePut: large + stream nextLargePut: large + +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextLongPut: long + stream nextLongPut: long + +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextPut: byte + stream nextPut: byte +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextPutAll: aByteArray + stream nextPutAll: aByteArray +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextULargePut: large + stream nextULargePut: large + +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextULongPut: long + stream nextULongPut: long +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +peek + ^stream peek +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +peek: n + ^stream peek: n +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +position + ^stream position +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +position: anInteger + stream position: anInteger +! ! + +!RelocatableBuffer methodsFor: 'relocation' stamp: 'KenD 28/Jun/2026 13:27:40'! +relocateTo: location with: solver + | delta | + delta := location - address. + address := location. + fixups do: [:fixup | fixup relocateBy: delta]. + self applyFixupsWith: solver +! ! + +!RelocatableBuffer methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +reset + fixups := OrderedCollection new. + stream reset +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +size + ^stream size +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +skip: anInteger + stream skip: anInteger +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stream + ^stream +! ! + +!RelocatableBuffer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +stream: aStream + stream := aStream +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeByte: byte at: location + | previous value | + previous := stream position. + value := byte < 0 ifTrue: [ byte + 256 ] ifFalse: [ byte ]. + stream + position: location - address; + nextBytePut: value; + position: previous +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeLong: long at: location + | previous | + previous := stream position. + stream + position: location - address; + nextLongPut: long; + position: previous +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RelocatableBuffer class' category: #'Powerlang-Core-Assembly'! +RelocatableBuffer class + instanceVariableNames: ''! + + +RelocatableBuffer initialize! + diff --git a/modules/LMR/Nativizer/Assembly/RelocationFixup.Class.st b/modules/LMR/Nativizer/Assembly/RelocationFixup.Class.st new file mode 100644 index 00000000..c2292402 --- /dev/null +++ b/modules/LMR/Nativizer/Assembly/RelocationFixup.Class.st @@ -0,0 +1,96 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #RelocationFixup category: #'Powerlang-Core-Assembly'! +Object subclass: #RelocationFixup + instanceVariableNames: 'source target relative size' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!RelocationFixup commentStamp: '' prior: 0! + +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addressSize + ^4 +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beAbsolute + relative := false. + size := self addressSize +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beRelative + relative := true +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +from: address1 to: address2 + source := address1. + target := address2 +! ! + +!RelocationFixup methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isRelative + ^relative +! ! + +!RelocationFixup methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +patch: buffer with: solver + | delta address | + address := solver resolveLabel: target. + self ASSERT: address notNil. + relative + ifTrue: [ + delta := address - source - size. + size = 1 + ifTrue: [buffer writeByte: delta at: source] + ifFalse: [buffer writeLong: delta at: source]] + ifFalse: [buffer writeLong: address at: source] +! ! + +!RelocationFixup methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + aStream + nextPutAll: self class name; + nextPut: $:; + space; + nextPutAll: target printString +! ! + +!RelocationFixup methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +relocateBy: delta + source := source + delta +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +size: anInteger + size := anInteger +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +target + ^target +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RelocationFixup class' category: #'Powerlang-Core-Assembly'! +RelocationFixup class + instanceVariableNames: ''! + +!RelocationFixup class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +absoluteFrom: source to: target + ^self new beAbsolute; from: source to: target +! ! + +!RelocationFixup class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +relativeFrom: source to: target + ^self new beRelative; from: source to: target +! ! + + diff --git a/modules/LMR/Nativizer/BinaryMessageNativizer.Class.st b/modules/LMR/Nativizer/BinaryMessageNativizer.Class.st new file mode 100644 index 00000000..b94a7fc2 --- /dev/null +++ b/modules/LMR/Nativizer/BinaryMessageNativizer.Class.st @@ -0,0 +1,444 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #BinaryMessageNativizer category: #Nativization! +Object subclass: #BinaryMessageNativizer + instanceVariableNames: 'message assembler nativizer done failed' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +argumentAt: index in: environment + nativizer argumentAt: index in: environment +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembler: anAssembler + assembler := anAssembler +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +failLabel + ^failed +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineBitAnd + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + andRwithA; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: #bitAnd:. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineBitAnd: selector + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + andRwithA; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: selector. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineBitOr: selector + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + orRwithA; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: selector. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineBitXor + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + xorRwithA; + setRintegerBit; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: #bitXor:. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineEquals + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + loadTwithR; + loadRwithTrue; + compareTwithA; + jumpIfEqualTo: done; + loadRwithFalse; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: #=. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineGreaterEqualThan + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + loadTwithR; + loadRwithTrue; + compareTwithA; + jumpIfGreaterOrEqualSignedTo: done; + loadRwithFalse; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: #<. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineGreaterThan + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + loadTwithR; + loadRwithTrue; + compareTwithA; + jumpIfGreaterSignedTo: done; + loadRwithFalse; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: #<. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineIdentityEquals + done := assembler newLabel. + self loadOperands. + assembler loadTwithR; loadRwithTrue; + compareTwithA; + jumpIfEqualTo: done; loadRwithFalse; @ done +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineLessEqualThan + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + loadTwithR; + loadRwithTrue; + compareTwithA; + jumpIfLessOrEqualSignedTo: done; + loadRwithFalse; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: #<. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineLessThan + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + loadTwithR; + loadRwithTrue; + compareTwithA; + jumpIfLessSignedTo: done; + loadRwithFalse; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: #<. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineMessage + | selector s | + s := message selector. + selector := s isSymbol + ifTrue: [ s ] + ifFalse: [ nativizer method at: s ]. + selector = #== + ifTrue: [ ^ self inlineIdentityEquals ]. + selector = #= + ifTrue: [ ^ self inlineEquals ]. + selector = #+ + ifTrue: [ ^ self inlinePlus ]. + selector = #< + ifTrue: [ ^ self inlineLessThan ]. + selector = #<= + ifTrue: [ ^ self inlineLessEqualThan ]. + selector = #>= + ifTrue: [ ^ self inlineGreaterEqualThan ]. + selector = #> + ifTrue: [ ^ self inlineGreaterThan ]. + selector = #- + ifTrue: [ ^ self inlineMinus ]. + selector = #* + ifTrue: [ ^ self inlineMultiply ]. + selector = #// + ifTrue: [ ^ self inlineQuotient ]. + selector = #\\ + ifTrue: [ ^ self inlineRemainder ]. + selector = #| + ifTrue: [ ^ self inlineBitOr: #| ]. + selector = #& + ifTrue: [ ^ self inlineBitAnd: #& ]. + " selector = #'>>' ifTrue: [^self inlineBitShiftLeft: #>>]. + selector = #'<<' ifTrue: [^self inlineBitShiftRight: #<<]." + selector = #bitOr: + ifTrue: [ ^ self inlineBitOr: #bitOr: ]. + selector = #bitAnd: + ifTrue: [ ^ self inlineBitAnd: #bitAnd: ]. + selector = #bitXor: + ifTrue: [ ^ self inlineBitXor ]. + " selector = #bitShift: ifTrue: [^self inlineBitShift]." + self ASSERT: false +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineMinus + | overflow | + done := assembler newLabel. + failed := assembler newLabel. + overflow := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + subAfromR; + jumpIfOverflowTo: overflow; + setRintegerBit; + @ done. + nativizer addFallback: [ + assembler + @ overflow; + addAtoR; + @ failed; + pushA. + nativizer emitSend: #'-'. + assembler jumpTo: done] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineMultiply + | overflow | + done := assembler newLabel. + failed := assembler newLabel. + overflow := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + pushA; + convertAtoNativeInteger; + loadTwithR; + clearRintegerBit; + multiplyRbyAwideningToA; + popA; + jumpIfOverflowTo: overflow; + setRintegerBit; + @ done. + nativizer + addFallback: [ assembler + @ overflow; + loadRwithT; + @ failed; + pushA. + nativizer emitSend: #*. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlinePlus + | overflow | + done := assembler newLabel. + failed := assembler newLabel. + overflow := assembler newLabel. + self loadOperands. + nativizer saveContextSwitchPoint. + assembler + clearRintegerBit; + addAtoR; + jumpIfOverflowTo: overflow; + @ done. + nativizer addFallback: [ + assembler + @ overflow; + subAfromR; + setRintegerBit; + @ failed; + pushA. + nativizer emitSend: #'+'. + assembler jumpTo: done] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineQuotient + | | + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + assembler + compareRwithSmallInteger: 0; + jumpIfLessOrEqualSignedTo: failed. + nativizer saveContextSwitchPoint. + assembler + convertRtoNativeInteger; + convertAtoNativeInteger; + loadTwithA; + extendRtoAandDividebyT; + convertRtoSmallInteger; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: #//. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineRemainder + done := assembler newLabel. + failed := assembler newLabel. + self loadOperands. + assembler + compareRwithSmallInteger: 0; + jumpIfLessOrEqualSignedTo: failed. + nativizer saveContextSwitchPoint. + assembler + convertRtoNativeInteger; + convertAtoNativeInteger; + loadTwithA; + extendRtoAandDividebyT; + loadRwithA; + convertRtoSmallInteger; + @ done. + nativizer + addFallback: [ assembler + @ failed; + pushA. + nativizer emitSend: #//. + assembler jumpTo: done ] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithArgument: index in: environment + nativizer loadAwithArgument: index in: environment +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithTemporary: index in: environment + nativizer loadAwithTemporary: index in: environment +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadOperands + message opcodes + do: [:hintcode | hintcode nativizeUsing: assembler for: self] +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRvisitingArgument + message arguments first acceptVisitor: nativizer +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRvisitingReceiver + message receiver acceptVisitor: nativizer +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithTemporary: index env: environment + nativizer temporaryAt: index in: environment +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +message: aMessageTreecode + message := aMessageTreecode +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +method + ^nativizer method +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodLiteralAt: index + ^nativizer methodLiteralAt: index +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizer: aTreecodeNativizer + nativizer := aTreecodeNativizer +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +popR + ^ nativizer popR +! ! + +!BinaryMessageNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushR + ^nativizer pushR +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BinaryMessageNativizer class' category: #Nativization! +BinaryMessageNativizer class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/CompositeMessageLinker.Class.st b/modules/LMR/Nativizer/CompositeMessageLinker.Class.st new file mode 100644 index 00000000..1cd2648b --- /dev/null +++ b/modules/LMR/Nativizer/CompositeMessageLinker.Class.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #CompositeMessageLinker category: #Nativization! +MessageLinker subclass: #CompositeMessageLinker + instanceVariableNames: 'candidates' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!CompositeMessageLinker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +add: aMessageLinker + candidates add: aMessageLinker +! ! + +!CompositeMessageLinker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +dispatchLinkerFor: selector + ^candidates + detect: [:linker | linker canInline: selector] + ifNone: [self error: 'cannot dispatch ', selector storeString] +! ! + +!CompositeMessageLinker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +emitSend: selector using: anAssembler + | linker | + linker := self dispatchLinkerFor: selector. + linker emitSend: selector using: anAssembler + +! ! + +!CompositeMessageLinker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +emitSendSuper: selector from: aClass using: anAssembler + | linker | + linker := self dispatchLinkerFor: selector. + linker emitSendSuper: selector from: aClass using: anAssembler +! ! + +!CompositeMessageLinker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + candidates := OrderedCollection new +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CompositeMessageLinker class' category: #Nativization! +CompositeMessageLinker class + instanceVariableNames: ''! + + +CompositeMessageLinker initialize! + diff --git a/modules/LMR/Nativizer/HaltingSend.Class.st b/modules/LMR/Nativizer/HaltingSend.Class.st new file mode 100644 index 00000000..b1009fa2 --- /dev/null +++ b/modules/LMR/Nativizer/HaltingSend.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #HaltingSend category: #Nativization! +MessageLinker subclass: #HaltingSend + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!HaltingSend methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitSend: aSymbol using: anAssembler + anAssembler breakpoint +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HaltingSend class' category: #Nativization! +HaltingSend class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/InlineMessageLinker.Class.st b/modules/LMR/Nativizer/InlineMessageLinker.Class.st new file mode 100644 index 00000000..af8bce55 --- /dev/null +++ b/modules/LMR/Nativizer/InlineMessageLinker.Class.st @@ -0,0 +1,984 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #InlineMessageLinker category: #Nativization! +MessageLinker subclass: #InlineMessageLinker + instanceVariableNames: 'assembler map' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleAsFloatInto + #_asFloatInto:. + assembler + loadX0withRasDouble; + storeLargeX0inA. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleAsNative + | noninteger | + #_asNative. + noninteger := assembler labeledIntegerBitTestOfR. + assembler + convertRtoNativeInteger; + @ noninteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleAsObject + #_asObject. + assembler clearSafeRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleAsPointer + | nonInteger | + #_asPointer. + nonInteger := assembler labeledIntegerBitTestOfR. + assembler + convertRtoNativeInteger; + @ nonInteger; + setSafeRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleAsSmallInteger + #_asSmallInteger. + assembler convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicAt + | oop | + #_basicAt:. + oop := assembler labeledIntegerNativizationOfA. + assembler + loadRwithRatA; + @ oop +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicAtPut + | nonInteger | + #_basicAt:put:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + storeTinRatA; + @ nonInteger; + loadRwithT +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicCopyFromToWith + #_basicCopyFrom:to:with:. + assembler + pushE; + convertAtoNativeInteger; + convertTtoNativeInteger; + loadEwithAddressOfRatA; + loadSwithAddressOfSatA; + subAfromT; + addTwithImmediate: 1; + moveTslots; + popE +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicFlags + #_basicFlags. + self emitByteAtOffset: _Flags +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicFlagsPut + #_basicFlags:. + self emitByteAtOffsetPut: _Flags +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicHash + #_basicHash. + assembler + loadZeroExtendShortRwithRoffset: _Hash; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicHashPut + | nonInteger | + #_basicHash:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + storeShortAinRoffset: _Hash; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicSize + #_smallSize. + self emitByteAtOffset: _SmallSize +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicSizePut + #_smallSize:. + self emitByteAtOffsetPut: _SmallSize +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicULongAt + | nonInteger | + #_basicULongAt:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + loadZeroExtendLongRwithRatA; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBasicULongAtPut + | nonInteger | + #_basicULongAt:put:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + storeLongTinRatA; + @ nonInteger; + loadRwithT +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBeCurrent + #_beCurrent. + assembler + loadRwithRindex: 1; + clearSafeRintegerBit; + loadFPwithR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBeEnvironment + #_beEnvironment. + assembler loadEwithR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBeFramePointer + #_beFramePointer. + assembler storeRinFPindex: 1 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBitShiftLeft + | success | + #_bitShiftLeft:. + success := assembler newLabel. + assembler + loadTwithA; + loadAwithR; + clearSafeRintegerBit; + convertTtoNativeInteger; + shiftLeftRwithT; + setSafeRintegerBit; + pushR; + shiftRightRwithT; + setSafeRintegerBit; + compareRwithA; + popR; + shortJumpIfEqualTo: success; + loadRwithNil; + @ success +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBitShiftRight + #_bitShiftRight:. + assembler + move: assembler regA to: assembler regT; + convertToNativeInteger: assembler regT; + shiftRightArithmetic: assembler regR by: assembler regT b; + setIntegerBit: assembler regR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleBusyWait + | loop | + #_busyWait. + loop := assembler newLabel. + assembler + loadTwithImmediate: 0; + @ loop; + exchangeRindirectWithT; + compareTwithImmediate: 0; + shortJumpIfEqualTo: loop +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleByteAt + | nonInteger | + #_byteAt:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + loadZeroExtendByteRwithRatA; + convertRtoSmallInteger; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleByteAtPut + | nonInteger1 nonInteger2 | + #_byteAt:put:. + nonInteger1 := assembler labeledIntegerNativizationOfA. + nonInteger2 := assembler labeledIntegerNativizationOfT. + assembler + storeByteTinRatA; + @ nonInteger1; + @ nonInteger2; + loadRwithT; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleCDeclCallWithArguments + #_cdeclCallWithArguments:. + assembler + loadZeroExtendByteTwithAindex: _SmallSize + 1; + shiftTright: assembler wordSizeShift; + pushS; + saveCallerFrame; + subTslotsToSP; + assemble: 'and' with: assembler regSP with: -16; + loopTtimes: [ assembler + load: assembler regS + fromMem: assembler memRefAatT; + store: assembler regS + intoMem: assembler memRefSPatT ]. + assembler addressSize = 8 + ifTrue: [ self loadArgumentsIntoRegisters ]. + assembler + callR; + restoreCallerFrame; + popS +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleCallWithArguments + #_stdcallWithArguments:. + assembler + loadZeroExtendByteTwithAindex: _SmallSize + 1; + shiftTright: assembler wordSizeShift; + loopTtimes: [ assembler pushAatToffset: 0 - assembler addressSize ]. + assembler addressSize = 8 + ifTrue: [ self loadArgumentsIntoRegisters ]. + assembler callR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleEnvironment + #_environment. + assembler loadRwithE +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleExpandInStackSized + #_expandInStackSized:. + assembler + convertAtoNativeInteger; + loadTwithA; + loopTtimes: [ assembler + pushIndirectR; + addRwithImmediate: assembler wordSize ] +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleExtendedSize + #_largeSize. + assembler + loadZeroExtendLongRwithRindex: _ExtendedSize; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleFloatEquals + " + first compare magnitudes to set error bit if NaN + " + #_floatEquals:. + assembler + pushR; + loadLargeX0withRindirect; + compareLessThanDoubleX0withAindirect; + popR; + loadLargeX0withRindirect; + compareEqualDoubleX0withAindirect; + moveX0toR; + addRwithImmediate: 1; + convertRtoSmallInteger. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleFloatFractionPartInto + #_floatFractionPartInto:. + assembler + loadLargeX0withRindirect; + roundDoubleX0intoX1; + subDoubleX1fromX0; + storeLargeX0inA. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleFloatLessThan + #_floatLessThan:. + assembler + loadLargeX0withRindirect; + compareLessThanDoubleX0withAindirect; + moveX0toR; + addRwithImmediate: 1; + convertRtoSmallInteger. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleFloatMinusInto + #_floatMinus:into:. + assembler + loadLargeX0withRindirect; + loadLargeX1withAindirect; + subDoubleX1fromX0; + storeLargeX0inT. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleFloatMultiplyInto + #_floatMultiply:into:. + assembler + loadLargeX0withRindirect; + loadLargeX1withAindirect; + multiplyDoubleX0byX1; + storeLargeX0inT. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleFloatPlusInto + #_floatPlus:into:. + assembler + loadLargeX0withRindirect; + loadLargeX1withAindirect; + addDoubleX1toX0; + storeLargeX0inT. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleFloatQuotientInto + #_floatQuotient:into:. + assembler + loadLargeX0withRindirect; + loadLargeX1withAindirect; + divideDoubleX0byX1; + storeLargeX0inT. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleFloatSqrtInto + #_floatSqrtInto:. + assembler + loadLargeX0withRindirect; + sqrtDoubleX0; + storeLargeX0inA. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleFloatTruncated + #_floatTruncated. + assembler loadRconvertingDoublePointedByR. + self readFloatStatus. + assembler convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleFramePointer + #_framePointer. + assembler loadRwithFPindex: 1 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleGetTIBValue + | nonInteger | + #_getThreadInformationBlockValue. + nonInteger := assembler labeledIntegerNativizationOfR. + assembler + loadRwithTIBatR; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleGetThreadValue + | nonInteger uninitialized | + #_getThreadValue. + nonInteger := assembler labeledIntegerNativizationOfR. + uninitialized := assembler newLabel. + assembler + loadRwithThreadVariableAtR; + compareRwithImmediate: 0; + shortJumpIfEqualTo: uninitialized. + assembler + jumpOver: [ assembler + @ uninitialized; + @ nonInteger; + loadRwithNil ] +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleHigh16 + #_high16. + assembler wordSize > 4 + ifTrue: [ assembler clearRhigh32 ]. + assembler + shiftRright: 15; + setSafeRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleHigh32 + #_high32. + assembler + shiftLogicalRright: 31; + setSafeRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleHoldRefererIfNeeded + #_holdRefererIfNeeded:. + assembler + pushA; + loadAwithGlobal: #WriteBarrier; + callIndirectA; + popA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleIntegerMultiplyByInto + #_integerMultiplyBy:into:. + assembler + convertRtoNativeInteger; + convertAtoNativeInteger; + multiplyRbyAwideningToA; + storeRinTindex: 1; + storeAinTindex: 2; + loadRwithT +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleInvoke + #_invoke:. + assembler + loadMwithA; + callIndirectM +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleLeadingZeroBitCount + #_leadingZeroBitCount. + assembler + convertRtoNativeInteger; + leadingRzeroCount; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleLoadFloatStatusFrom + #_status:. + assembler loadMXCSRfromA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleLow16 + #_low16. + assembler + andRwithImmediate: 16rFFFF; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleLow32 + #_low32. + assembler wordSize > 4 + ifTrue: [ assembler + andRwithImmediate: 16rFFFFFFFF; + convertRtoSmallInteger ] +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleNativeHalt + #_halt. + assembler breakpoint +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleNilSlots + #_nilSlots:. + assembler + pushE; + loadEwithR; + loadRwithNil; + loadTwithA; + convertTtoNativeInteger; + writeTslots; + popE +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleObjectAtOffset + | nonInteger1 | + #_objectAtOffset:. + nonInteger1 := assembler labeledIntegerNativizationOfA. + assembler + loadRwithRatOffsetA; + @ nonInteger1 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleObjectAtOffsetPut + | oop | + #_objectAtOffset:put:. + oop := assembler labeledIntegerNativizationOfA. + assembler + storeTinRatOffsetA; + @ oop; + loadRwithT; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleOop + #_oop. + ^ assembler convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleQuotientTowardZero + #_quotientTowardZero:. + assembler + convertRtoNativeInteger; + convertAtoNativeInteger; + loadTwithA; + extendRtoAandDividebyT; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleRelease + #_release. + assembler + lock; + decRindirect +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleRemainderTowardZero + | adapt convert | + #_remainderTowardZero:. + adapt := assembler newLabel. + convert := assembler newLabel. + assembler + convertRtoNativeInteger; + convertAtoNativeInteger; + loadTwithA; + xorAwithR; + jumpIfSignTo: adapt; + extendRtoAandDividebyT; + loadRwithA; + jumpTo: convert; + @ adapt; + extendRtoAandDividebyT; + loadRwithA; + testRwithR; + jumpIfZeroTo: convert; + addTtoR; + @ convert; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleRestore + #_restore. + assembler loadEwithR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleRestoreAndTransferControlWithContext + #_restoreAndTransferControlWithContext:. + assembler + clearSafeRintegerBit; + loadFPwithR; + loadSPwithFP; + loadRwithA; + clearSafeRintegerBit; + loadFPwithR; + popR; + loadEwithR; + restoreCallerSelf; + restoreCallerM; + loadRwithS; + return: 0 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleRestoreWithContext + #_restoreWithContext:. + assembler + clearSafeRintegerBit; + loadFPwithR; + loadSPwithFP; + loadRwithA; + clearSafeRintegerBit; + loadFPwithR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleSaveCurrentEnvironment + #_saveCurrentEnvironment. + assembler + clearSafeRintegerBit; + pushE; + popT; + storeTinRindex: 1; + setSafeRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleSetTIBValue + #_setThreadInformationBlockValue:. + assembler + convertRtoNativeInteger; + storeTIBatRwithA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleSetThreadValue + | nonInteger | + #_setThreadValue:. + nonInteger := assembler labeledIntegerNativizationOfR. + assembler + storeAinThreadVariableAtIndexR; + convertRtoSmallInteger. + assembler @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleSmallIntegerByteAt + | nonInteger | + #_smallIntegerByteAt:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + convertRtoNativeInteger; + pushR; + loadZeroExtendByteRwithSPatA; + convertRtoSmallInteger; + popA; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleStoreDoubleResult + #_storeDoubleResult. + assembler storeDoubleResultInRindirect +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleStoreFloatStatusInto + #_readStatusOn:. + assembler storeMXCSRintoA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleTestSmallInteger + | integer | + #_isSmallInteger. + integer := assembler newLabel. + assembler + testRintegerBit; + loadRwithTrue; + shortJumpIfNotZeroTo: integer; + loadRwithFalse; + @ integer +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleThisContext + #_thisContext. + assembler loadRwithFP setRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleTimesTwoPower + #_timesTwoPower:. + assembler clearFPUFlags scaleFloatOnRWithA clearFPUFlags +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleTransferControlDiscardingLastArgTo + #_transferControlDiscardingLastArgTo:. + assembler + restoreCallerFrame; + popSPindirect; + loadMwithA; + jumpToMindex: 1 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleTransferControlTo + #_transferControlTo:. + assembler restoreCallerFrame; loadMwithA; jumpToMindex: 1 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleULargeAtOffset + | overflow1 overflow2 end | + #_uLargeAtOffset:. + overflow1 := assembler newLabel. + overflow2 := assembler newLabel. + end := assembler newLabel. + assembler + convertAtoNativeInteger; + loadRwithRatOffsetA; + shiftRleft: 1; + shortJumpIfCarryTo: overflow1; + shortJumpIfSignTo: overflow2; + setRintegerBit; + shortJumpTo: end. + assembler + @ overflow1; + @ overflow2; + loadRwithNil; + @ end +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleULargeAtOffsetInto + #_uLargeAtOffset:into:. + assembler + convertAtoNativeInteger; + loadAwithRoffsetAtA; + storeAinTindex: 1; + loadRwithT +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleULargeAtOffsetPut + | end notSmall | + #_uLargeAtOffset:put:. + notSmall := assembler + convertAtoNativeInteger; + labeledIntegerBitTestOfT. + end := assembler newLabel. + assembler + convertTtoNativeInteger; + shortJumpTo: end; + @ notSmall; + loadTwithTindex: 1; + @ end; + storeTinRatOffsetA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleULongAtOffset + | overflow1 overflow2 end | + #_uLongAtOffset:. + overflow1 := assembler newLabel. + overflow2 := assembler newLabel. + end := assembler newLabel. + assembler + convertAtoNativeInteger; + loadLongRwithRatOffsetA; + shiftRleft: 1; + shortJumpIfCarryTo: overflow1; + shortJumpIfSignTo: overflow2; + setRintegerBit; + shortJumpTo: end. + assembler + @ overflow1; + @ overflow2; + loadRwithNil; + @ end +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleULongAtOffsetInto + #_uLongAtOffset:into:. + assembler + convertAtoNativeInteger; + loadLongRwithRatOffsetA; + storeRinTindex: 1; + loadRwithT +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleULongAtOffsetPut + | end oop | + #_uLongAtOffset:put:. + oop := assembler + convertAtoNativeInteger; + labeledIntegerBitTestOfT. + end := assembler newLabel. + assembler + convertTtoNativeInteger; + shortJumpTo: end; + @ oop; + loadTwithTindex: 1; + @ end; + storeLongTinRatOffsetA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleUShortAtOffsetPut + | end notSmall | + #_uShortAtOffset:put:. + notSmall := assembler + convertAtoNativeInteger; + labeledIntegerBitTestOfT. + end := assembler newLabel. + assembler + convertTtoNativeInteger; + shortJumpTo: end. + assembler + @ notSmall; + loadTwithTindex: 1; + @ end; + storeShortTinRatOffsetA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026 13:27:40'! +assembleZeroSlots + #_zeroSlots:. + assembler + pushE; + loadEwithR; + loadRwithImmediate: 0; + loadTwithA; + convertTtoNativeInteger; + writeTslots; + popE +! ! + +!InlineMessageLinker methodsFor: 'private - helpers' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitByteAtOffset: offset + assembler + loadZeroExtendByteRwithRindex: offset + 1; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - helpers' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitByteAtOffsetPut: offset + | nonInteger | + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + storeByteAinRindex: offset + 1; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitSend: aSymbol using: anAssembler + | arity selector | + assembler := anAssembler. + arity := aSymbol arity. + arity > 2 ifTrue: [assembler pop: assembler regS]. + arity > 1 ifTrue: [assembler pop: assembler regT]. + arity > 0 ifTrue: [assembler pop: assembler regA]. + self ASSERT: arity <= 3 . + selector := map at: aSymbol. + self perform: selector +! ! + +!InlineMessageLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitSendDebuggable: aSymbol using: anAssembler + self emitSend: aSymbol using: anAssembler +! ! + +!InlineMessageLinker methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + map := Dictionary new. + self class supported do:[:each|map add: each]. + self filter: map keys asIdentitySet + + " + InlineMessageLinker new + " + +! ! + +!InlineMessageLinker methodsFor: 'private - helpers' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadArgumentsIntoRegisters + | stack1 stack2 stack3 stack4 | + stack1 :=assembler memRef: rsp indexImm: 1. + stack2 :=assembler memRef: rsp indexImm: 2. + stack3 :=assembler memRef: rsp indexImm: 3. + stack4 :=assembler memRef: rsp indexImm: 4. + assembler + load: rcx fromMem: stack1; + load: rdx fromMem: stack2; + load: r8 fromMem: stack3; + load: r9 fromMem: stack4; + assemble: 'movq' with: xmm0 with: rcx; + assemble: 'movq' with: xmm1 with: rdx; + assemble: 'movq' with: xmm2 with: r8; + assemble: 'movq' with: xmm3 with: r9 +! ! + +!InlineMessageLinker methodsFor: 'private - helpers' stamp: 'KenD 28/Jun/2026 13:27:40'! +readFPUStatus + assembler + loadAwithKnown: #FloatStatus; + readFPUStatusOnA +! ! + +!InlineMessageLinker methodsFor: 'private - helpers' stamp: 'KenD 28/Jun/2026 13:27:40'! +readFloatStatus + assembler + loadAwithKnown: #FloatStatus; + storeMXCSRintoA +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlineMessageLinker class' category: #Nativization! +InlineMessageLinker class + instanceVariableNames: ''! + +!InlineMessageLinker class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeInlineMessageLinkerFlags + self addNamespaceAs: #InlineMessageLinkerFlags. + InlineMessageLinkerFlags + at: #_Flags put: -5; + at: #_SmallSize put: -6; + at: #_Hash put: -8; + at: #_Reserved put: -2; + at: #_ExtendedSize put: -3. + +! ! + +!InlineMessageLinker class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +supported + | selectors | + selectors := self organization selectorsFor: #'private - assemble'. + ^selectors collect: [:selector | | cm key | + cm := self >> selector. + key := cm literals detect: [:each | each isSymbol and:[each first == $_ ]]. + key -> selector]. + + " + InlineMessageLinker supported + " + +! ! + + +InlineMessageLinker initialize! + diff --git a/modules/LMR/Nativizer/InlinedMessageNativizer.Class.st b/modules/LMR/Nativizer/InlinedMessageNativizer.Class.st new file mode 100644 index 00000000..c3df68fd --- /dev/null +++ b/modules/LMR/Nativizer/InlinedMessageNativizer.Class.st @@ -0,0 +1,535 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #InlinedMessageNativizer category: #Nativization! +Object subclass: #InlinedMessageNativizer + instanceVariableNames: 'message assembler nativizer start end' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!InlinedMessageNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembler: anAssembler + assembler := anAssembler +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineAnd + | skip conditions | + skip := assembler newLabel. + conditions := Array + with: message receiver + withAll: message arguments allButLast. + conditions do: [ :c | self inlineAndCondition: c skip: skip ]. + message arguments last statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler @ skip +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineAndCondition: anSExpression skip: skip + | retry failed | + retry := assembler newLabel. + failed := assembler newLabel. + anSExpression acceptVisitor: nativizer. + assembler + @ retry; + compareRwithFalse; + jumpIfEqualTo: skip; + compareRwithTrue; + jumpIfNotEqualTo: failed. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineAndNot + | skip conditions | + skip := assembler newLabel. + conditions := Array + with: message receiver + withAll: message arguments allButLast. + conditions do: [ :c | self inlineAndCondition: c skip: skip ]. + message arguments last statements + do: [ :s | s acceptVisitor: nativizer ]. + self negateBoolean. +assembler @ skip +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineBinaryWhile: aBoolean + | retry failed block continue | + start := assembler newLabel. + retry := assembler newLabel. + failed := assembler newLabel. + block := assembler newLabel. + continue := assembler newLabel. + assembler + alignTo: 16; + @ start. + message receiver statements do: [ :s | s acceptVisitor: nativizer ]. + assembler + @ retry; + compareRwithBoolean: aBoolean; + jumpIfEqualTo: block; + compareRwithBoolean: aBoolean not; + jumpIfNotEqualTo: failed; + jumpTo: continue; + @ block. + message arguments first statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler + jumpTo: start; + @ continue. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineBranchIf: aBoolean + | retry failed first second | + retry := assembler newLabel. + failed := assembler newLabel. + end := assembler newLabel. + message receiver acceptVisitor: nativizer. + first := aBoolean not. + second := aBoolean. + assembler + @ retry; + loadAwithR; + loadRwithNil; + compareAwithBoolean: first; + jumpIfEqualTo: end; + compareAwithBoolean: second; + jumpIfNotEqualTo: failed. + message arguments first statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler @ end. + nativizer + addFallback: [ assembler @ failed; loadRwithA. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineBranchIfNil: aBoolean + + end := assembler newLabel. + message receiver acceptVisitor: nativizer. + assembler + compareRwithNil. + aBoolean + ifTrue: [ assembler jumpIfNotEqualTo: end ] + ifFalse: [ assembler jumpIfEqualTo: end ]. + message arguments first acceptVisitor: nativizer. + assembler @ end +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineBranchIfNilIfNotNil: aBoolean + | second | + second := assembler newLabel. + end := assembler newLabel. + message receiver acceptVisitor: nativizer. + assembler compareRwithNil. + aBoolean + ifTrue: [ assembler jumpIfNotEqualTo: second ] + ifFalse: [ assembler jumpIfEqualTo: second ]. + message arguments first acceptVisitor: nativizer. + assembler + jumpTo: end; + @ second. + message arguments first acceptVisitor: nativizer. + assembler @ end +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineIfTrueIfFalse: aBoolean + | retry other failed first second | + retry := assembler newLabel. + other := assembler newLabel. + failed := assembler newLabel. + end := assembler newLabel. + message receiver acceptVisitor: nativizer. + first := aBoolean not. + second := aBoolean. + assembler + @ retry; + compareRwithBoolean: first; + jumpIfEqualTo: other; + compareRwithBoolean: second; + jumpIfNotEqualTo: failed. + message arguments first statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler + jumpTo: end; + @ other. + message arguments second statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler @ end. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineMessage + | selector | + selector := message selector. + selector = #ifTrue: + ifTrue: [ ^ self inlineBranchIf: true ]. + selector = #ifFalse: + ifTrue: [ ^ self inlineBranchIf: false ]. + selector = #ifNil: + ifTrue: [ ^ self inlineBranchIfNil: true ]. + selector = #ifNotNil: + ifTrue: [ ^ self inlineBranchIfNil: false ]. + selector = #ifNil:ifNotNil: + ifTrue: [ ^ self inlineBranchIfNilIfNotNil: true ]. + selector = #ifNil:ifNotNil: + ifTrue: [ ^ self inlineBranchIfNilIfNotNil: false ]. + selector = #ifTrue:ifFalse: + ifTrue: [ ^ self inlineIfTrueIfFalse: true ]. + selector = #ifFalse:ifTrue: + ifTrue: [ ^ self inlineIfTrueIfFalse: false ]. + selector = #whileTrue + ifTrue: [ ^ self inlineUnitaryWhile: true ]. + selector = #whileFalse + ifTrue: [ ^ self inlineUnitaryWhile: false ]. + selector = #whileTrue: + ifTrue: [ ^ self inlineBinaryWhile: true ]. + selector = #whileFalse: + ifTrue: [ ^ self inlineBinaryWhile: false ]. + selector = #repeat + ifTrue: [ ^ self inlineRepeat ]. + selector = #to:do: + ifTrue: [ ^ self inlineToDo ]. + selector = #to:by:do: + ifTrue: [ ^ self inlineToByDo]. + selector = #timesRepeat: + ifTrue: [ ^ self inlineTimesRepeat ]. + (selector beginsWith: #or:) + ifTrue: [ ^ self inlineOr ]. + (selector beginsWith: #and:) + ifTrue: [ ^ self inlineAnd ]. + selector = #andNot: + ifTrue: [ ^ self inlineAndNot ]. + selector = #orNot: + ifTrue: [ ^ self inlineOrNot ]. + self ASSERT: false +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineOr + | skip conditions | + skip := assembler newLabel. + conditions := Array + with: message receiver + withAll: message arguments allButLast. + conditions do: [ :c | self inlineOrCondition: c skip: skip ]. + message arguments last statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler @ skip +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineOrBlock: b skip: skip + | retry failed | + retry := assembler newLabel. + failed := assembler newLabel. + b statements acceptVisitor: nativizer. + assembler + @ retry; + compareRwithTrue; + jumpIfEqualTo: skip; + compareRwithFalse; + jumpIfNotEqualTo: failed. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineOrCondition: anSExpression skip: skip + | retry failed | + retry := assembler newLabel. + failed := assembler newLabel. + + anSExpression acceptVisitor: nativizer. + assembler + @ retry; + compareRwithTrue; + jumpIfEqualTo: skip; + compareRwithFalse; + jumpIfNotEqualTo: failed. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineOrNot + | skip conditions | + skip := assembler newLabel. + conditions := Array + with: message receiver + withAll: message arguments allButLast. + conditions do: [ :c | self inlineOrCondition: c skip: skip ]. + message arguments last statements + do: [ :s | s acceptVisitor: nativizer ]. + self negateBoolean. + assembler @ skip +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineRepeat + start := assembler newLabel. + assembler + alignTo: 16; + @ start. + message receiver statements do: [ :s | s acceptVisitor: nativizer ]. + assembler jumpTo: start +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineTimesRepeat + | head block continue nonInteger nonDecrementable current | + head := assembler newLabel. + block := assembler newLabel. + continue := assembler newLabel. + nonInteger := assembler newLabel. + nonDecrementable := assembler newLabel. + message receiver acceptVisitor: nativizer. + current := nativizer pushR. + assembler + alignTo: 16; + @ head; + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonInteger; + compareRwithSmallInteger: 0; + jumpIfLessOrEqualSignedTo: continue; + @ block. + message arguments first statements + do: [ :s | s acceptVisitor: nativizer ]. + nativizer loadRwithStack: current. + assembler + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonDecrementable; + subFromRconstant: 2. + nativizer storeRInStack: current. + assembler + jumpTo: head; + @ continue. + nativizer + dropTos; + addFallback: [ assembler + @ nonDecrementable; + pushSmallInteger: 1. + nativizer + emitSend: #-; + storeRInStack: current. + assembler jumpTo: head ]; + addFallback: [ assembler + @ nonInteger; + pushSmallInteger: 0. + nativizer emitSend: #>. + assembler + compareRwithTrue; + jumpIfEqualTo: block; + jumpTo: continue ] + +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineToByDo + | head block continue nonInteger nonIncrementable overflow current limit by increment | + head := assembler newLabel. + block := assembler newLabel. + continue := assembler newLabel. + nonInteger := assembler newLabel. + nonIncrementable := assembler newLabel. + overflow := assembler newLabel. + message receiver acceptVisitor: nativizer. + current := message arguments third inlinedArgs first. + nativizer temporaryInStackAtPut: current. + message arguments first acceptVisitor: nativizer. + limit := nativizer pushR. + assembler loadAwithR. + nativizer temporaryInStackAt: current. + assembler + alignTo: 16; + @ head; + testIntegerBitOf: assembler regA; + jumpIfZeroTo: nonInteger; + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonInteger; + compareRwithA. + by := message arguments second value. + by > 0 + ifTrue: [ assembler jumpIfGreaterSignedTo: continue ] + ifFalse: [ assembler jumpIfLessSignedTo: continue ]. + increment := (assembler smallInteger: by) - 1. + assembler @ block. + message arguments third statements + do: [ :s | s acceptVisitor: nativizer ]. + nativizer temporaryInStackAt: current. + assembler + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonIncrementable; + addRwithImmediate: increment; + jumpIfOverflowTo: overflow. + nativizer + temporaryInStackAtPut: current; + loadAwithStack: limit. + assembler + jumpTo: head; + @ continue. + nativizer dropTos; + addFallback: [ assembler + @ overflow; + subFromRconstant: increment; + @ nonIncrementable; + pushSmallInteger: 1. + nativizer + emitSend: #+; + temporaryInStackAtPut: current; + loadAwithStack: limit. + assembler jumpTo: head ]; + addFallback: [ assembler + @ nonInteger; + pushA. + nativizer emitSend: #<=. + assembler + compareRwithTrue; + jumpIfEqualTo: block; + jumpTo: continue ] + +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineToDo + | head block continue nonInteger nonIncrementable overflow current limit | + head := assembler newLabel. + block := assembler newLabel. + continue := assembler newLabel. + nonInteger := assembler newLabel. + nonIncrementable := assembler newLabel. + overflow := assembler newLabel. + message receiver acceptVisitor: nativizer. + current := message arguments second inlinedArgs first. + nativizer temporaryInStackAtPut: current. + message arguments first acceptVisitor: nativizer. + limit := nativizer pushR. + assembler loadAwithR. + nativizer temporaryInStackAt: current. + assembler + alignTo: 16; + @ head; + testIntegerBitOf: assembler regA; + jumpIfZeroTo: nonInteger; + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonInteger; + compareRwithA; + jumpIfGreaterSignedTo: continue; + @ block. + message arguments second statements + do: [ :s | s acceptVisitor: nativizer ]. + nativizer temporaryInStackAt: current. + assembler + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonIncrementable; + addRwithImmediate: 2; + jumpIfOverflowTo: overflow. + nativizer + temporaryInStackAtPut: current; + loadAwithStack: limit. + assembler + jumpTo: head; + @ continue. + nativizer dropTos; + addFallback: [ assembler + @ overflow; + subFromRconstant: 2; + @ nonIncrementable; + pushSmallInteger: 1. + nativizer + emitSend: #+; + temporaryInStackAtPut: current; + loadAwithStack: limit. + assembler jumpTo: head ]; + addFallback: [ assembler + @ nonInteger; + pushA. + nativizer emitSend: #<=. + assembler + compareRwithTrue; + jumpIfEqualTo: block; + jumpTo: continue ] + +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineUnitaryWhile: aBoolean + | continue failed | + start := assembler newLabel. + continue := assembler newLabel. + failed := assembler newLabel. + assembler + alignTo: 16; + @ start. + message receiver statements do: [ :s | s acceptVisitor: nativizer ]. + assembler + compareRwithBoolean: aBoolean; + jumpIfEqualTo: start; + compareRwithBoolean: aBoolean not; + jumpIfNotEqualTo: failed; + @ continue. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: continue ] +! ! + +!InlinedMessageNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +message: aMessageTreecode + message := aMessageTreecode +! ! + +!InlinedMessageNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +nativizer: aTreecodeNativizer + nativizer := aTreecodeNativizer +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +negateBoolean + | retry failed done | + retry := assembler newLabel. + failed := assembler newLabel. + done := assembler newLabel. + assembler + @ retry; + loadAwithR; + loadRwithFalse; + compareRwithA; + jumpIfEqualTo: done; + loadRwithTrue; + compareRwithA; + jumpIfNotEqualTo: failed; @done. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlinedMessageNativizer class' category: #Nativization! +InlinedMessageNativizer class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/InvokeLinker.Class.st b/modules/LMR/Nativizer/InvokeLinker.Class.st new file mode 100644 index 00000000..41d51568 --- /dev/null +++ b/modules/LMR/Nativizer/InvokeLinker.Class.st @@ -0,0 +1,58 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #InvokeLinker category: #Nativization! +MessageLinker subclass: #InvokeLinker + instanceVariableNames: 'invoker sends' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMethod: aCompiledMethod + self addMethod: aCompiledMethod for: aCompiledMethod selector +! ! + +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMethod: aCompiledMethod for: aSymbol + | instructions send | + filter add: aSymbol. + instructions := invoker ifNil: [ aCompiledMethod nativeCode code ]. + send := SendSite invoking: aCompiledMethod using: instructions. + sends at: aSymbol put: send +! ! + +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMethods: aCollection + aCollection do: [:m | self addMethod: m] +! ! + +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +emitSend: aSymbol using: anAssembler + | send | + send := sends at: aSymbol. + anAssembler + loadAwithLiteral: send; + callIndirectA; + discardArguments: aSymbol arity +! ! + +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + sends := Dictionary new. + self filter: #() +! ! + +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +invoker: aNativeCode + invoker := aNativeCode +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InvokeLinker class' category: #Nativization! +InvokeLinker class + instanceVariableNames: ''! + + +InvokeLinker initialize! + diff --git a/modules/LMR/Nativizer/LazyLinker.Class.st b/modules/LMR/Nativizer/LazyLinker.Class.st new file mode 100644 index 00000000..23ba1e3f --- /dev/null +++ b/modules/LMR/Nativizer/LazyLinker.Class.st @@ -0,0 +1,37 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #LazyLinker category: #Nativization! +LookupLinker subclass: #LazyLinker + instanceVariableNames: 'sends' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!LazyLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitSend: aSymbol using: anAssembler + | send | + send := super emitSend: aSymbol using: anAssembler. + sends add: send +! ! + +!LazyLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + sends := OrderedCollection new + +! ! + +!LazyLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sends + ^sends + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LazyLinker class' category: #Nativization! +LazyLinker class + instanceVariableNames: ''! + + +LazyLinker initialize! + diff --git a/modules/LMR/Nativizer/LookupLinker.Class.st b/modules/LMR/Nativizer/LookupLinker.Class.st new file mode 100644 index 00000000..1a96503c --- /dev/null +++ b/modules/LMR/Nativizer/LookupLinker.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #LookupLinker category: #Nativization! +MessageLinker subclass: #LookupLinker + instanceVariableNames: 'lookup lookupSuper' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!LookupLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +emitSend: aSymbol using: anAssembler + | send | + send := SendSite new lookup: aSymbol using: lookup. + anAssembler + loadAwithLiteral: send; + callIndirectA; + discardArguments: aSymbol arity. + ^send +! ! + +!LookupLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +emitSendSuper: aSymbol from: aClass using: anAssembler + | send behavior | + send := SendSite new lookup: aSymbol using: lookupSuper; beSuperSend. + behavior := aClass superclass map instanceBehavior. + anAssembler + loadAwithLiteral: send; + loadTwithLiteral: behavior; + callIndirectA; + discardArguments: aSymbol arity. + ^send +! ! + +!LookupLinker methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeFrom: anLMRModule + lookup := anLMRModule lookupStub. + lookupSuper := anLMRModule lookupSuperStub. + +! ! + +!LookupLinker methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookup: aByteArray + lookup := aByteArray +! ! + +!LookupLinker methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupSuper: aByteArray + lookupSuper := aByteArray +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LookupLinker class' category: #Nativization! +LookupLinker class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/LookupNativizer.Class.st b/modules/LMR/Nativizer/LookupNativizer.Class.st new file mode 100644 index 00000000..4efc844a --- /dev/null +++ b/modules/LMR/Nativizer/LookupNativizer.Class.st @@ -0,0 +1,119 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #LookupNativizer category: #'Powerlang-Core-Building'! +Object subclass: #LookupNativizer + instanceVariableNames: 'nativizer methods' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Building'! +!LookupNativizer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +closureMethods + ^ self selectorLookupMethods , self globalLookupMethods + , self otherLookupMethods , nativizer class undermethods + , self sendSiteMethods +! ! + +!LookupNativizer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +globalLookupMethods + | result out global | + result := OrderedCollection new. + result + add: ProtoObject >> #_cachedLookup:; + add: ProtoObject >> #_cachedLookup:in:; + add: Thread metaclass >> #currentGlobalLookup; + add: GlobalDispatchCache metaclass >> #current. + out := #(initialize flushAll: flush:forSpecies: flush:for: flush:for:startingAt:). + global := GlobalDispatchCache methods + reject: [ :m | out includes: m selector ]. + ^ result + addAll: global; + yourself +! ! + +!LookupNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodFor: selector + ^methods detect: [:m | m selector == selector]. + +! ! + +!LookupNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methods + ^methods +! ! + +!LookupNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizeMethods + | environment | + methods := self closureMethods collect: [:m | nativizer compile: m ]. + environment := self newNativizationEnvironment. + methods do: [:m | environment nativize: m] +! ! + +!LookupNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizer: aNativizationEnvironment + nativizer := aNativizationEnvironment +! ! + +!LookupNativizer methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +newNativizationEnvironment + | environment ignored lookup invoke | + environment := NativizationEnvironment new + platform: nativizer platform; + globals: nativizer globals; + optimizedMethods: nativizer optimizedMethods. + ignored := HaltingSend new + filter: #(< <= = > + - * // bitAnd: bitOr: bitXor:). + lookup := LookupLinker new initializeFrom: environment. + lookup + filter: + #(debuggableCopy acquireReferences nativize refreshBlocks doesNotUnderstandSelector: mustBeBoolean class allocateMoreCaches). + invoke := InvokeLinker new + invoker: environment invokeStub; + addMethods: methods. + ^ environment + addLinker: invoke; + addLinker: ignored; + addLinker: lookup; + completeInitialization +! ! + +!LookupNativizer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +otherLookupMethods + ^ OrderedCollection new + add: ProtoObject >> #objectAtValid:put:; + add: ProtoObject >> #behavior; + add: CompiledMethod >> #prepareForExecution; + add: CompiledMethod >> #isNativized; + add: CompiledMethod >> #validNativeCodeAddress; + add: CompiledMethod >> #nativeCode; + add: CompiledMethod >> #selector; + add: NativeCode >> #code; + add: NativeCode >> #compiledCode; + add: Species >> #instanceBehavior; + add: Process >> #wantsToStepInto; + yourself +! ! + +!LookupNativizer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +selectorLookupMethods + ^ OrderedCollection new + add: SendSite >> #_lookup:; + add: SendSite >> #_lookup:in:; + add: SendSite >> #_lookup:inDictionary:; + yourself +! ! + +!LookupNativizer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +sendSiteMethods + | sendsite | + ^ #(_dispatchOn: _dispatchOn:startingAt: _dispatchDebuggableOn: _dispatchDebuggableOn:startingAt: sentSelector when:use: beInvoke:using: bePolymorphic isStaticSend monomorphicMap:to: polymorphicMap:to: maxSize reset takeNextFreeMIC takeNextFreePIC) + collect: [ :s | SendSite >> s ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LookupNativizer class' category: #'Powerlang-Core-Building'! +LookupNativizer class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/MessageLinker.Class.st b/modules/LMR/Nativizer/MessageLinker.Class.st new file mode 100644 index 00000000..ec6cc337 --- /dev/null +++ b/modules/LMR/Nativizer/MessageLinker.Class.st @@ -0,0 +1,28 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #MessageLinker category: #Nativization! +Object subclass: #MessageLinker + instanceVariableNames: 'filter' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!MessageLinker methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canInline: aSymbol + filter ifNil: [ ^true ]. + filter == aSymbol ifTrue: [ ^true ]. + ^(filter includes: aSymbol) +! ! + +!MessageLinker methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +filter: anObject + filter := anObject. + filter isCollection ifTrue: [filter := filter asIdentitySet] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MessageLinker class' category: #Nativization! +MessageLinker class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/NativizationEnvironment.Class.st b/modules/LMR/Nativizer/NativizationEnvironment.Class.st new file mode 100644 index 00000000..befd07c8 --- /dev/null +++ b/modules/LMR/Nativizer/NativizationEnvironment.Class.st @@ -0,0 +1,219 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #NativizationEnvironment category: #Nativization! +Object subclass: #NativizationEnvironment + instanceVariableNames: 'platform optimizedMethods invokedMethods inlinedMethods messageLinker writeBarrier safepointCheck cachedNativizer busy' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +abi + ^platform abi +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addLinker: aLinker + messageLinker add: aLinker +! ! + +!NativizationEnvironment methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +completeInitialization + cachedNativizer := self newTemplateJIT +! ! + +!NativizationEnvironment methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + busy := false. + optimizedMethods := OrderedCollection new. + invokedMethods := OrderedCollection new. + inlinedMethods := OrderedCollection new. + messageLinker := CompositeMessageLinker new. + messageLinker add: InlineMessageLinker new. +! ! + +!NativizationEnvironment methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeLinkersFor: anLMRModule + | invoker dispatcher | + invoker := InvokeLinker new invoker: anLMRModule invokeStub; addMethods: invokedMethods. + dispatcher := LookupLinker new initializeFrom: anLMRModule. + self + addLinker: invoker; + addLinker: dispatcher; + completeInitialization +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlinedMethods + ^inlinedMethods +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlinedMethods: aCollection + inlinedMethods := aCollection +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +invokedMethods + ^invokedMethods +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +invokedMethods: aCollection + invokedMethods := aCollection asOrderedCollection +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +messageLinker + ^messageLinker +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +messageLinker: aLinker + messageLinker := aLinker +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodNativizer + ^cachedNativizer +! ! + +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativize: aCompiledMethod + ^(self shouldOptimize: aCompiledMethod) + ifTrue: [ self nativizeOptimizing: aCompiledMethod ] + ifFalse: [ self nativizeWithoutOptimizing: aCompiledMethod ] +! ! + +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizeOptimizing: aCompiledMethod + self optimizingNativizer + method: aCompiledMethod; + nativize +! ! + +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizerDuring: aBlock + ^busy + ifFalse: [ + busy := true. + [ aBlock value: cachedNativizer ] ensure: [ busy := false ] ] + ifTrue: [ + | old | + old := cachedNativizer. + [ + cachedNativizer := self newTemplateJIT. + aBlock value: cachedNativizer ] ensure: [ cachedNativizer := old ] ] +! ! + +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizeWithoutOptimizing: aCompiledMethod + | method | + method := self + nativizerDuring: [ :jit | jit nativize: aCompiledMethod ]. + ^method +! ! + +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +newAssembler + ^platform newAssembler +! ! + +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +newTemplateJIT + ^TemplateJIT new environment: self +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +optimizedMethods + ^optimizedMethods +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +optimizedMethods: aCollection + optimizedMethods := aCollection +! ! + +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +optimizingNativizer + ^OptimizingNativizer new environment: self +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +platform + ^platform +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +platform: aNativizationPlatform + platform := aNativizationPlatform +! ! + +!NativizationEnvironment methodsFor: 'printing & storing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + "append a printed representation of the receiver to the argument, aStream" + + super printOn: aStream. + aStream nextPutAll: '(platform: '. + platform name printOn: aStream. + aStream nextPut: $) +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +safepointCheck: anObject + safepointCheck := anObject +! ! + +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +sexpressionOffsetsOf: code + | method | + method := code method. + (self shouldOptimize: method) ifTrue: [ ^#( ) ]. + ^self nativizerDuring: [ :nativizer | + method nativeCode ifNotNil: [ method := method copy ]. + nativizer compile: method. + nativizer sexpressionOffsetsOf: code ] +! ! + +!NativizationEnvironment methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:40'! +shouldInline: aSymbol + ^inlinedMethods anySatisfy: [ :m | m selector = aSymbol ] +! ! + +!NativizationEnvironment methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:40'! +shouldOptimize: method + | selector classname | + selector := method selector. + classname := method classBinding name. + ^optimizedMethods anySatisfy: [:m | m selector = selector and: [ m classBinding name = classname ] ] +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSize + ^self abi wordSize +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +wordSizeShift + ^self abi wordSizeShift +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeBarrier + ^writeBarrier +! ! + +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeBarrier: aCompiledMethod + writeBarrier := aCompiledMethod. + invokedMethods add: writeBarrier +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NativizationEnvironment class' category: #Nativization! +NativizationEnvironment class + instanceVariableNames: ''! + + +NativizationEnvironment initialize! + diff --git a/modules/LMR/Nativizer/NativizationPlatform.Class.st b/modules/LMR/Nativizer/NativizationPlatform.Class.st new file mode 100644 index 00000000..b71fdca2 --- /dev/null +++ b/modules/LMR/Nativizer/NativizationPlatform.Class.st @@ -0,0 +1,143 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #NativizationPlatform category: #Nativization! +Object subclass: #NativizationPlatform + instanceVariableNames: 'name wordSize abi codeGeneratorClass' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!NativizationPlatform methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +abi + self ASSERT: abi notNil. + ^ abi +! ! + +!NativizationPlatform methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +abi: anABI + self ASSERT: abi isNil. + self ASSERT: anABI notNil. + + abi := anABI. +! ! + +!NativizationPlatform methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +codeGeneratorClass: aClass + self ASSERT: codeGeneratorClass isNil. + self ASSERT: aClass notNil. + + codeGeneratorClass := aClass. +! ! + +!NativizationPlatform methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + "super initialize. -- commented since inherited method does nothing" +! ! + +!NativizationPlatform methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + self ASSERT: name notNil. + ^ name +! ! + +!NativizationPlatform methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aString + self ASSERT: name isNil. + self ASSERT: aString notNil. + + name := aString. +! ! + +!NativizationPlatform methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +newCodeGenerator + self ASSERT: codeGeneratorClass notNil. + + ^ codeGeneratorClass new platform: self. +! ! + +!NativizationPlatform methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +newAssembler + ^ abi newAssembler platform: self +! ! + +!NativizationPlatform methodsFor: 'printing & storing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + super printOn:aStream. + aStream nextPut: $(. + name printOn:aStream. + aStream nextPut: $). +! ! + +!NativizationPlatform methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +wordSize + self ASSERT: wordSize notNil. + ^ wordSize +! ! + +!NativizationPlatform methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +wordSize: anInteger + self ASSERT: wordSize isNil. + self ASSERT:(anInteger == 8 or:[ anInteger == 4]). + + wordSize := anInteger. +! ! + +!NativizationPlatform methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +wordSizeShift + ^ #(0 0 0 2 0 0 0 3) at: self wordSize +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NativizationPlatform class' category: #Nativization! +NativizationPlatform class + instanceVariableNames: ''! + +!NativizationPlatform class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +host + "Return platform for the machine this code is running on." + + | host | + + host := Kernel host. + host = 'x86_64-linux-gnu' ifTrue:[ ^ self x86_64_linux_gnu ]. + host = 'x86_64-darwin' ifTrue:[ ^ self x86_64_darwin ]. + host = 'x86_64-win32' ifTrue:[ ^self x86_64_win32 ]. + + host = 'riscv64-linux-gnu' ifTrue:[ ^ self riscv64_linux_gnu ]. + + self error:'Unssuported host: ', host. +! ! + +!NativizationPlatform class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +x86_64_darwin + ^ self new + name: 'x86_64-darwin'; + wordSize: 8; + abi: SysVX64ABI new; + codeGeneratorClass: AMD64CodeGenerator; + yourself +! ! + +!NativizationPlatform class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +x86_64_linux_gnu + ^ self new + name: 'x86_64-linux-gnu'; + wordSize: 8; + abi: SysVX64ABI new; + codeGeneratorClass: AMD64CodeGenerator; + yourself +! ! + +!NativizationPlatform class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +x86_64_win32 + ^ self new + name: 'x86_64-win32'; + wordSize: 8; + abi: WinX64ABI new; + codeGeneratorClass: AMD64CodeGenerator; + yourself +! ! + + +NativizationPlatform initialize! + diff --git a/modules/LMR/Nativizer/NativizerModule.Class.st b/modules/LMR/Nativizer/NativizerModule.Class.st new file mode 100644 index 00000000..4b362563 --- /dev/null +++ b/modules/LMR/Nativizer/NativizerModule.Class.st @@ -0,0 +1,268 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #NativizerModule category: #Nativization! +Module subclass: #NativizerModule + instanceVariableNames: 'environment' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization'! +!NativizerModule commentStamp: '' prior: 0! + + Copyright (c) 2023, Javier Pimás. + See (MIT) license in root directory. +! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:40'! +bootstrap: anLMRModule with: aPlatform + environment := self newNativizationEnvironmentFor: aPlatform. + + self + nativizeInvokeFor: anLMRModule; + nativizeWriteBarrierFor: anLMRModule; + nativizeLookupFor: anLMRModule; + nativizeSendSiteStubs. + + environment initializeLinkersFor: anLMRModule; completeInitialization +! ! + +!NativizerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! +environment + ^environment +! ! + +!NativizerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! +imports + ^{ + #Kernel -> #(Behavior CharacterArray Closure CompiledBlock CompiledMethod Float OrderedCollection ProtoObject Species String). + #Kernel.LMR -> #(LMRProtoObject LMRFloat LMRSpecies). + #LMR -> #(CriticalArray GCSpace GlobalDispatchCache Memory NativeCode SendSite Thread). + } +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeFor: anLMRModule with: aPlatform + environment := self newNativizationEnvironmentFor: aPlatform. + environment initializeLinkersFor: anLMRModule; completeInitialization +! ! + +!NativizerModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlinedMethods + | map | + map := { + (ProtoObject -> #(#basicObjectIndexOf: #class #objectAtValid: #objectAtValid:put:)). + (LMRProtoObject -> #(#behavior #primitiveAt: #_cachedLookup: #_cachedLookup:in:)). + (Object -> #(#byteAtValid: #byteAtValid:put: #at:put:)). + (Species -> #(#instSize #_instancesAreArrayed #_instancesHavePointers #instanceBehavior)). + (LMRSpecies -> #(#memory #primitiveNew #primitiveNew:)). + (CompiledMethod -> #(#prepareForExecution #isNativized #executableCode #blockCount #literalIndexFrom:)). + (CompiledBlock -> #(#argumentCount #blockNumber #blockCode #method)). + (NativeCode -> #(#code)). + (GCSpace -> #(#commitedLimit #nextFree #nextFree:)). + (CharacterArray -> #(#characterAtValid:))}. + ^self undermethods , (self methodSubset: map) +! ! + +!NativizerModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +invokedMethods + | map | + map := { + (ProtoObject -> #(class)). + (LMRProtoObject -> #(behavior #initializeExtended:contentSize: primitiveAt:)). + (Object -> #(_replaceFrom:to:with:)). + (Species -> #(instanceBehavior _instancesAreArrayed _instancesHavePointers)). + (LMRSpecies -> #(allocate:size: nil:slotsOf: memory primitiveNewBytes: primitiveNewPointers: zero:bytesOf:))}. + ^self undermethods , (self methodSubset: map) +! ! + +!NativizerModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +justLoaded + InlineMessageLinker initializeInlineMessageLinkerFlags +! ! + +!NativizerModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodSubset: associations + | result dict | + result := OrderedCollection new. + dict := Dictionary withAll: associations. + dict keysAndValuesDo: [ :species :selectors | + selectors collect: [:sel | | m | species >> sel ifNil: [self ASSERT: false] ] in: result]. + ^result +! ! + +!NativizerModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +optimizedMethods + | map | + map := { + (ProtoObject -> #(basicByteAt: #basicByteAt:put: basicObjectAt: #basicObjectAt:put: class)). + (LMRProtoObject -> #(behavior primitiveAt: #primitiveAt:put: #initializeExtended:contentSize:)). + (Object -> #(at: #at:put: byteAtValid: #byteAtValid:put: #replaceBytesForwardFrom:to:with:startingAt:)). + (SendSite -> #(_dispatchOn: #_dispatchOn:startingAt: _dispatchDebuggableOn: #_dispatchDebuggableOn:startingAt:)). + (Species -> #(instSize)). + (LMRSpecies -> #(allocate:size: primitiveNew primitiveNew: primitiveNewBytes: primitiveNewPointers:)). + (LMRFloat class -> #(new)). + (CompiledBlock -> #(argumentCount arity blockCode method)). + (Closure -> #(value value: #value:value:)). + (CompiledMethod -> #(blockCount isNativized)). + (String -> #(at: #at:put: byteAt: #byteAt:put:)). + (GCSpace -> #(lockedAllocateIfPossible: shallowCopy:)). + (Memory -> #(shallowCopy:))}. + ^self undermethods , (self methodSubset: map) +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizeInvokeFor: anLMRModule + | invoke | + invoke := SendSite >> #_invokeOn:. + environment nativizeOptimizing: invoke. + anLMRModule mapGlobal: #Invoke to: invoke +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizeLookupFor: anLMRModule + | nativizer lookup lookupSuper | + nativizer := LookupNativizer new + environment: environment; + nativizeMethods. + lookup := nativizer methodFor: #_dispatchOn:. + lookupSuper := nativizer methodFor: #_dispatchOn:startingAt:. + anLMRModule + mapGlobal: #Lookup to: lookup executableCode; + mapGlobal: #LookupSuper to: lookupSuper executableCode +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizeMonomorphicCache + | asm lookup next smiGlobal lookupGlobal | + asm := environment newAssembler. + lookup := asm newLabel. + smiGlobal := self indexOfGlobal: #SmallIntegerBehavior. + lookupGlobal := self indexOfGlobal: #Lookup + asm + loadTwithAindex: 3; + loadSwithGindex: smiGlobal. + next := asm labeledNonIntegerBitTestOfR. + asm + loadLongSwithRindex: 0; + @ next; + compareSwithTindex: 1; + shortJumpIfNotEqualTo: lookup; + loadMwithTindex: 2; + jumpToMindex: 1; + @ lookup; + loadMwithGindex: lookupGlobal; + jumpToMindex: 1; + applyFixups. + ^asm nativeCode code +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizePolymorphicCache + | asm smi lookupGlobal case2 case3 case4 case5 case6 case7 lookup | + asm := environment newAssembler. + smi := asm newLabel. + case2 := asm newLabel. + case3 := asm newLabel. + case4 := asm newLabel. + case5 := asm newLabel. + case6 := asm newLabel. + case7 := asm newLabel. + lookup := asm newLabel. + asm loadTwithAindex: 3. + smi := asm labeledNonIntegerBitTestOfR. + lookupGlobal := self indexOfGlobal: #Lookup. + asm + loadLongSwithRindex: 0; + compareSwithTindex: 1; + shortJumpIfNotEqualTo: case2; + loadMwithTindex: 2; + jumpToMindex: 1; + @ case2; + compareSwithTindex: 3; + shortJumpIfNotEqualTo: case3; + loadMwithTindex: 4; + jumpToMindex: 1; + @ case3; + compareSwithTindex: 5; + shortJumpIfNotEqualTo: case4; + loadMwithTindex: 6; + jumpToMindex: 1; + @ case4; + compareSwithTindex: 7; + shortJumpIfNotEqualTo: case5; + loadMwithTindex: 8; + jumpToMindex: 1; + @ case5; + compareSwithTindex: 9; + shortJumpIfNotEqualTo: case6; + loadMwithTindex: 10; + jumpToMindex: 1; + @ case6; + compareSwithTindex: 11; + shortJumpIfNotEqualTo: case7; + loadMwithTindex: 12; + jumpToMindex: 1; + @ case7; + compareSwithTindex: 13; + shortJumpIfNotEqualTo: lookup; + loadMwithTindex: 14; + jumpToMindex: 1; + @ lookup; + loadMwithGindex: lookupGlobal; + jumpToMindex: 1; + @ smi; + loadMwithTindex: 15; + jumpToMindex: 1; + applyFixups. + ^asm nativeCode code +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizeSendSiteStubs + SendSite + monomorphicCache: self nativizeMonomorphicCache; + polymorphicCache: self nativizePolymorphicCache. +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizeWriteBarrierFor: anLMRModule + | map inlined barrier dispatcher | + map := { + (Memory class -> #(current)). + (Memory -> #(isYoung: isYoungSafe: remember:)). + (CriticalArray -> #(unsafeAdd: #unsafeAt:put:)). + (Magnitude -> #(#between:and:)) + }. + inlined := self methodSubset: map. + inlined addAll: self undermethods. + barrier := ProtoObject >> #holdRefererIfNeeded:. + dispatcher := LookupLinker new initializeFrom: nativizer. + NativizationEnvironment new + platform: environment platform; + inlinedMethods: inlined; + messageLinker: dispatcher; + completeInitialization; + nativizeOptimizing: barrier. + anLMRModule mapGlobal: #WriteBarrier to: barrier executableCode +! ! + +!NativizerModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +newNativizationEnvironmentFor: aPlatform + ^NativizationEnvironment new + platform: aPlatform; + inlinedMethods: self inlinedMethods; + invokedMethods: self invokedMethods; + optimizedMethods: self optimizedMethods +! ! + +!NativizerModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +undermethods + ^SendSite undermethods +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NativizerModule class' category: #Nativization! +NativizerModule class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OActivationContext.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OActivationContext.Class.st new file mode 100644 index 00000000..66806e7b --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OActivationContext.Class.st @@ -0,0 +1,65 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OActivationContext category: #IR! +OLoadImplicit subclass: #OActivationContext + instanceVariableNames: 'hasFrame temporaries storesPreviousSelf' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OActivationContext commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OActivationContext methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +doSavePreviousSelf + storesPreviousSelf := true +! ! + +!OActivationContext methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasFrame + ^hasFrame +! ! + +!OActivationContext methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +haveFrame + hasFrame := true +! ! + +!OActivationContext methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + hasFrame := false. + storesPreviousSelf := false +! ! + +!OActivationContext methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +savesPreviousSelf + ^storesPreviousSelf +! ! + +!OActivationContext methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +temporaries + ^temporaries +! ! + +!OActivationContext methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +temporaries: aNumber + temporaries := aNumber. + aNumber > 0 ifTrue: [self haveFrame] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OActivationContext class' category: #IR! +OActivationContext class + instanceVariableNames: ''! + +!OActivationContext class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OActivationContext initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OBasicBlock.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OBasicBlock.Class.st new file mode 100644 index 00000000..52b8b659 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OBasicBlock.Class.st @@ -0,0 +1,837 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OBasicBlock category: #IR! +Object subclass: #OBasicBlock + instanceVariableNames: 'firstInstruction lastInstruction predecessors' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OBasicBlock commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +activationRecord + ^self firstInstruction +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +add: instruction + ^lastInstruction beforeInsert: instruction +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addFront: instruction + ^firstInstruction afterInsert: instruction +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addPredecessor: aBasicBlock + predecessors add: aBasicBlock +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allDominators + | result all changed | + result := Dictionary new. + all := self withSuccessorsPostOrder. + all do: [:block | result at: block put: (Set with: block)]. + changed := true. + [changed] whileTrue: [| current | + changed := false. + all reverseDo: [:block | | incoming | + incoming := block predecessors collect: [:pred | result at: pred]. + current := incoming isEmpty ifTrue: [Set new] ifFalse: [ + incoming + inject: incoming first + into: [:intersection :doms | doms intersection: intersection]]. + current add: block. + current size !!= (result at: block) size ifTrue: [ + result at: block put: current. + changed := true]]]. + ^result +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allLoopHeads + | loops doms | + loops := Dictionary new. + doms := self allDominators. + self withSuccessorsPostOrder do: [:block | + block successors + do: [:succ | ((doms at: block) includes: succ) + ifTrue: [loops add: succ -> block]]]. + ^loops +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allLoops + | result | + result := Dictionary new. + self allLoopHeads + keysAndValuesDo: [:head :tail | result + at: head + put: (tail withPredecessorsUntil: head)]. + ^result +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +asArray + ^self asReversePostOrderInstructionsCollection asArray +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +asReversePostOrderInstructionsCollection + | collection | + collection := OrderedCollection new. + self + instructionsWithReversePostOrderSuccessorsDo: [:inst | collection + add: inst]. + ^collection +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +cleanPredecessors + predecessors := OrderedCollection new +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeLiveOutInto: liveOut andLiveInInto: liveIn + | blocks changed | + blocks := self withSuccessorsPostOrder. + blocks reverseDo: [:block | | in out | + in := OrderedCollection new. + out := OrderedCollection new. + liveOut at: block put: out. + liveIn at: block put: in]. + changed := true. + [changed] whileTrue: [ + changed := false. + blocks reverseDo: [:block | | live out size | + live := block successors gather: [:succ | liveIn at: succ]. + out := liveOut at: block. + size := out size. + out := out addAll: live; withoutDuplicates. + changed := changed or: [out size !!= size]. + block lastInstruction reverseDo: [:instruction | + instruction operandsDo: [:argument | + live addIfAbsent: argument. + live removeIfPresent: instruction]. + liveIn at: block put: live]]] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dissolveIfUnreachable + predecessors isEmpty ifTrue: [ + self lastValue + ifNotNil: [:last | last reverseDo: [:instruction | instruction dissolve]]] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dominanceFrontiers + | idoms | + idoms := self dominatorTree allImmediateDominators. + ^self dominanceFrontiersUsing: idoms +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dominanceFrontiersUsing: idoms + | blocks result | + blocks := self withSuccessorsPostOrder. + result := Dictionary new. + blocks do: [:block | result at: block put: OrderedCollection new]. + blocks do: [:block | + block predecessors size > 1 ifTrue: [ + block predecessors do: [:predecessor | | runner end | + runner := predecessor. + end := idoms at: block. + [runner !!= end] whileTrue: [| frontiers | + frontiers := result at: runner. + (frontiers includes: block) ifFalse: [frontiers add: block]. + runner := idoms at: runner]]]]. + ^result +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dominatorTree + | all root idoms indices intersect changed | + all := self updatePredecessors withSuccessorsPostOrder reversed. + idoms := Array new: all size. + idoms at: 1 put: 1. + root := all first. + indices := Dictionary new. + all withIndexDo: [:block :index | indices at: block put: index]. + intersect := [:index1 :index2 | | finger1 finger2 | + finger1 := index1. + finger2 := index2. + [finger1 !!= finger2] whileTrue: [ + finger1 > finger2 + ifTrue: [finger1 := idoms at: finger1] + ifFalse: [finger2 := idoms at: finger2]]. + finger1]. + changed := true. + [changed] whileTrue: [ + changed := false. + (all copyFrom: 2) + withIndexDo: [:block :index | | processed initial intersection | + processed := block predecessors select: [:predecessor | | i | + i := indices at: predecessor. + (idoms at: i) notNil]. + initial := indices at: processed first. + intersection := processed + inject: initial + into: [:actual :predecessor | | candidate | + candidate := indices at: predecessor. + intersect value: actual value: candidate]. + intersection !!= (idoms at: index + 1) ifTrue: [ + idoms at: index + 1 put: intersection. + changed := true]]]. + ^ODominatorTree from: root with: all dominators: idoms +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +endWith: jumpType to: target skipping: skipped if: compare + | jump | + jump := jumpType variable: compare target: target implicitTarget: skipped. + compare addUse: jump at: #variable. + self lastInstruction afterInsert: jump +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +endWithJumpFalseTo: target skipping: skipped if: condition + self endWith: OJumpFalse to: target skipping: skipped if: condition +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +endWithJumpTo: target + | jump | + jump := OJump to: target. + self lastInstruction afterInsert: jump +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +endWithJumpTrueTo: target skipping: skipped if: condition + self endWith: OJumpTrue to: target skipping: skipped if: condition +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstInstruction + ^firstInstruction next +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstNonPhi + ^self firstInstruction firstNonPhi +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fullyRemovePredecessor: predecessor + self + removePredecessor: predecessor; + phisDo: [:phi | phi removeBlock: predecessor]. + predecessors isEmpty + ifTrue: [self successors do: [:succ | succ fullyRemovePredecessor: self]] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +ifHasExplicitSuccesor: explicitBlock ifHasImplicitSuccesor: implicitBlock + | last | + last := self lastInstruction. + last isJump ifFalse: [^self]. + explicitBlock value: last target. + last isConditionalJump ifTrue: [implicitBlock value: last implicitTarget] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +incorporatePhisFrom: predecessor + | index | + predecessors size = 1 ifTrue: [^predecessor movePhisTo: self]. + self phisDo: [:phi | | source parents vars | + index := phi blocks indexOf: predecessor. + source := phi variables at: index. + parents := predecessor predecessors. + vars := (predecessor phis includes: source) + ifTrue: [source variables copy] + ifFalse: [OrderedCollection new: parents size withAll: source]. + vars withIndexDo: [:var :i | | pred | + pred := parents at: i. + phi addVariable: var from: pred]. + phi removeVariable: source at: index] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +indexOf: anInstruction + | current | + current := 1. + self instructionsDo: [:instruction | + instruction == anInstruction ifTrue: [^current]. + current := current + 1]. + self error: 'instruction not found' +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + firstInstruction := OInstruction empty. + lastInstruction := firstInstruction next. + predecessors := OrderedCollection new +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeWith: anInstruction + firstInstruction := anInstruction cutPrevious. + lastInstruction := firstInstruction last next. + predecessors := OrderedCollection new +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inline: inlined replacing: aMessageSend + | returned return join last | + last := inlined lastBlock. + return := last lastValue. + returned := return source. + aMessageSend replaceAllUsesWith: returned. + return dissolve. + inlined successors isEmpty ifFalse: [ + join := self splitAfter: aMessageSend. + join addPredecessor: last. + last endWithJumpTo: join]. + aMessageSend dissolveReplacingWithAll: inlined firstInstruction. + self replaceAsPredecessor: inlined. + ^join ifNil: [self] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPhiOf: block1 and: block2 replacing: operation + | value1 value2 | + value1 := block1 lastValue. + value2 := block2 lastValue. + (value1 == nil or: [value2 == nil]) ifTrue: [^operation dissolve]. + self + insertPhiOf: value1 + at: block1 + and: value2 + at: block2 + replacing: operation +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPhiOf: value1 at: block1 and: value2 at: block2 replacing: operation + | phi | + phi := OPhi with: value1 from: block1 with: value2 from: block2. + self firstInstruction beforeInsert: phi. + operation replaceAllUsesWith: phi; dissolve +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPhiOf: value1 at: block1 and: block2 replacing: operation + | value2 | + value2 := block2 lastValue. + value2 == nil ifTrue: [^operation dissolve]. + self + insertPhiOf: value1 + at: block1 + and: value2 + at: block2 + replacing: operation +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsAfter: first withReversePostOrderSuccessorsDo: aBlock + first do: aBlock. + self withSuccessorsPostOrder + removeLast; + reverseDo: [:block | block instructionsDo: aBlock] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsAsCollection + | collection | + collection := OrderedCollection new. + self instructionsDo: [:inst | collection add: inst]. + ^collection +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsDo: aBlock + ^firstInstruction do: aBlock +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsSelect: condition thenDo: aBlock + ^firstInstruction + do: [:next | (condition value: next) ifTrue: [aBlock value: next]] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsWithPostOrderSuccessorsDo: aBlock + self postOrderDo: [:block | block instructionsDo: aBlock] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsWithReversePostOrderSuccessorsDo: aBlock + self reversePostOrderDo: [:block | block instructionsDo: aBlock] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsWithSuccessorsDo: aBlock + self withSuccessorsDo: [:block | block instructionsDo: aBlock] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isEmptyBranch + self instructionsDo: [:instruction | ^instruction isConditionalJump] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isEmptyJump + self instructionsDo: [:instruction | ^instruction isUnconditionalJump] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isEmptyPhiBranch + self instructionsDo: [:instruction | | empty | + empty := instruction isPhi and: [| next | + next := instruction next. + next isConditionalJump + and: [next variable == instruction and: [instruction isUsedJustOnce]]]. + ^empty] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isOnlyPhiBranch + | last | + last := self lastInstruction. + last isConditionalJump ifFalse: [^false]. + self instructionsDo: [:instruction | + instruction = last ifTrue: [^true]. + instruction isPhi ifFalse: [^false]] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPhiArgument: instruction + self phisDo: [:phi | (phi variables includes: instruction) ifTrue: [^true]]. + ^false +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +iteratedDominanceFrontiersOf: blocks using: frontiers + | result changed | + result := (blocks gather: [:block | frontiers at: block]) asSet. + changed := true. + [changed] whileTrue: [| size more | + size := result size. + more := result gather: [:block | frontiers at: block]. + result addAll: more. + changed := size !!= result size]. + ^result +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +lastBlock + ^self postOrderDo: [:block | ^block] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +lastInstruction + ^lastInstruction prev +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +lastPhi + ^self firstInstruction lastPhi +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +lastValue + | last | + last := lastInstruction lastValue. + ^last = firstInstruction + ifTrue: [predecessors size = 1 ifTrue: [predecessors first lastValue]] + ifFalse: [last] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +length + | current | + current := 0. + self instructionsDo: [:instruction | current := current + 1]. + ^current +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +movePhisTo: otherBlock + | inst dest | + inst := self firstInstruction. + dest := otherBlock firstInstruction prev. + [inst isPhi] whileTrue: [| next | + next := inst next. + dest afterInsert: inst. + dest := inst. + inst := next] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^'#' , self hash printString +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +phis + | result | + result := OrderedCollection new. + self + instructionsDo: [:instr | instr isPhi + ifTrue: [result add: instr] + ifFalse: [^result]] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +phisDo: aBlock + self + instructionsDo: [:instr | instr isPhi + ifTrue: [aBlock value: instr] + ifFalse: [^self]] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +phiValuesComingFrom: block + ^self phis collect: [:phi | phi atOperand: block] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +phiWithArgument: instruction + self phisDo: [:phi | (phi variables includes: instruction) ifTrue: [^phi]]. + self error: 'not found' +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +postOrder: result seen: seen + seen add: self. + self + ifHasExplicitSuccesor: [:next | (seen includes: next) + ifFalse: [next postOrder: result seen: seen]] + ifHasImplicitSuccesor: [:next | (seen includes: next) + ifFalse: [next postOrder: result seen: seen]]. + result add: self +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +postOrderDo: aBlock + self withSuccessorsPostOrder do: [:block | aBlock value: block] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +predecessors + ^predecessors +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printAll + | stream | + stream := '' writeStream. + self reversePostOrderDo: [:block | + block printOn: stream. + stream cr]. + ^stream contents +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printAllNamed + | stream names vars blocks | + stream := '' writeStream. + names := Dictionary new. + vars := 0. + blocks := 0. + self reversePostOrderDo: [:block | + block instructionsDo: [:inst | + names at: inst put: 'v' , vars printString. + vars := vars + 1]. + names at: block put: 'B' , blocks printString. + blocks := blocks + 1]. + self reversePostOrderDo: [:block | + block printOn: stream using: names. + stream cr]. + ^stream contents +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream + nextPutAll: '<=== ' , self name , String cr , firstInstruction asString + , '===>' +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream using: names + | string | + string := names at: self. + aStream nextPutAll: '<=== ' , string , ' [' , self hash printString , '] \'. + predecessors size > 0 ifTrue: [ + predecessors allButLast + do: [:pred | aStream + nextPutAll: (names at: pred ifAbsent: 'missing') , ' | ']. + aStream nextPutAll: (names at: predecessors last ifAbsent: 'missing')]. + aStream + nextPutAll: '/' , String cr , (firstInstruction printStringUsing: names) + , '===>' +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +realInstructionsDo: aBlock + | current | + current := self firstInstruction. + [current isPhi] whileTrue: [current := current next]. + current do: aBlock +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +removePredecessor: aBasicBlock + predecessors remove: aBasicBlock +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceAsPredecessor: old + self successors do: [:succ | succ replacePredecessor: old with: self] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replacePredecessor: old with: new + self phisDo: [:phi | phi replaceBlock: old with: new]. + predecessors replace: old with: new +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +reversePostOrderDo: aBlock + self withSuccessorsPostOrder reverseDo: [:block | aBlock value: block] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +sortPhiVariables + self phisDo: [:phi | phi sortAfter: predecessors] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +split + ^self class new +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +splitAfter: anInstruction + | next | + next := self class newStartingWith: anInstruction next. + lastInstruction := anInstruction cutFollowing. + next replaceAsPredecessor: self. + ^next +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +splitAllCriticalEdges + self withSuccessorsPostOrder + do: [:block | block splitIncomingCriticalEdges] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +splitBefore: anInstruction + ^self splitAfter: anInstruction prev +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +splitEdgeIfCriticalTo: succ + ^(self successors size > 1 and: [succ predecessors size > 1]) + ifTrue: [self splitEdgeTo: succ] + ifFalse: [succ] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +splitEdgeTo: block + | middle jump branch | + middle := self class new. + jump := OJump to: block. + middle add: jump. + branch := self lastInstruction. + branch target = block + ifTrue: [branch target: middle] + ifFalse: [branch implicitTarget: middle]. + middle addPredecessor: self. + block replacePredecessor: self with: middle. + ^middle +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +splitIncomingCriticalEdges + predecessors size > 1 ifTrue: [ + predecessors + do: [:pred | pred successors size > 1 ifTrue: [pred splitEdgeTo: self]]] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +successors + ^lastInstruction prev targets +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +successorsPostOrder + | seen result | + seen := Set new. + result := OrderedCollection new: 10. + self + ifHasExplicitSuccesor: [:next | (seen includes: next) + ifFalse: [next postOrder: result seen: seen]] + ifHasImplicitSuccesor: [:next | (seen includes: next) + ifFalse: [next postOrder: result seen: seen]]. + ^result +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +unifyReturns + | all last extra ret prev end jump phi | + all := self withSuccessorsPostOrder. + last := all removeFirst. + extra := OrderedCollection new. + all do: [:block | | potential | + potential := block lastInstruction prev. + potential class = OReturn ifTrue: [extra add: potential -> block]]. + extra size = 0 ifTrue: [^self]. + ret := last lastInstruction. + prev := ret prev. + (prev isPhi and: prev = last firstInstruction) + ifTrue: [ + end := last. + phi := prev] + ifFalse: [ + end := last splitAfter: prev. + end addPredecessor: last. + jump := OJump to: end. + prev afterInsert: jump. + phi := OPhi new. + phi + addVariable: ret source from: last; + addUse: ret at: #source. + ret source removeUse: ret at: #source. + ret source: phi; beforeInsert: phi]. + extra do: [:assoc | | tail block | + tail := assoc key. + block := assoc value. + phi addVariable: tail source from: block. + end addPredecessor: block. + jump := tail next. + jump target removePredecessor: block. + jump target: end. + tail dissolve] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +updatePredecessors + self + postOrderDo: [:block | block cleanPredecessors]; + postOrderDo: [:block | block successors + do: [:successor | successor addPredecessor: block]]; + postOrderDo: [:block | block sortPhiVariables] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + firstInstruction + detect: [:instruction | instruction usesResultOf: anInstruction] + ifNone: [^false]. + ^true +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +verifyAllInstructionsSanity + self withSuccessorsDo: [:block | | forward current backwards | + forward := OrderedCollection new. + current := block instVarNamed: #firstInstruction. + [current == nil] whileFalse: [ + forward add: current. + current := current next]. + backwards := OrderedCollection new. + current := forward last. + [current == nil] whileFalse: [ + backwards add: current. + current := current prev]. + self ASSERT: forward = backwards reversed] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +verifyAllPredecessorsSanity + self withSuccessorsDo: [:block | + block successors + do: [:successor | self ASSERT: (successor predecessors includes: block)]. + block predecessors + do: [:predecessor | self ASSERT: (predecessor successors includes: block)]] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +withPredecessors + | result incoming | + result := OrderedCollection new. + incoming := OrderedCollection with: self. + [ + result addAll: incoming. + incoming := incoming gather: #predecessors. + incoming removeAllSuchThat: [:pred | result includes: pred]. + incoming isEmpty] whileFalse. + ^result +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +withPredecessorsUntil: block + | result incoming | + result := OrderedCollection new. + incoming := OrderedCollection with: self. + [ + result addAll: incoming. + incoming := incoming gather: #predecessors. + incoming + removeAllSuchThat: [:pred | pred == block or: [result includes: pred]]. + incoming isEmpty] whileFalse. + ^result +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +withSuccessorsDo: aBlock + | done remaining | + done := Set new. + remaining := OrderedCollection new: 10. + remaining add: self. + [remaining notEmpty] whileTrue: [| block more | + block := remaining removeFirst. + aBlock value: block. + done add: block. + more := block successors + reject: [:succesor | (done includes: succesor) + or: [remaining includes: succesor]]. + remaining addAll: more] +! ! + +!OBasicBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +withSuccessorsPostOrder + | seen result | + seen := Set new. + result := OrderedCollection new: 10. + self postOrder: result seen: seen. + ^result +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OBasicBlock class' category: #IR! +OBasicBlock class + instanceVariableNames: ''! + +!OBasicBlock class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + +!OBasicBlock class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +newStartingWith: anInstruction + ^self basicNew initializeWith: anInstruction +! ! + + +OBasicBlock initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OBeginInstruction.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OBeginInstruction.Class.st new file mode 100644 index 00000000..b5d8d324 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OBeginInstruction.Class.st @@ -0,0 +1,76 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OBeginInstruction category: #IR! +OInstruction subclass: #OBeginInstruction + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OBeginInstruction commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OBeginInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + +! ! + +!OBeginInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +do: aBlock + next do: aBlock +! ! + +!OBeginInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasPrev + ^false +! ! + +!OBeginInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printBackwardOn: aStream + +! ! + +!OBeginInstruction methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: '[' , self basicHash printString , '] '. + next printForwardOn: aStream +! ! + +!OBeginInstruction methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream using: names + aStream nextPutAll: '[' , self basicHash printString , '] '. + next printForwardOn: aStream using: names +! ! + +!OBeginInstruction methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + | stream | + stream := '' writeStream. + next printForwardOn: stream using: names. + ^stream contents +! ! + +!OBeginInstruction methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +realReverseDo: aBlock + +! ! + +!OBeginInstruction methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +reverseDo: aBlock + +! ! + +!OBeginInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OBeginInstruction class' category: #IR! +OBeginInstruction class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OBinaryConstantOperation.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OBinaryConstantOperation.Class.st new file mode 100644 index 00000000..6b98db51 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OBinaryConstantOperation.Class.st @@ -0,0 +1,48 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OBinaryConstantOperation category: #IR! +OBinaryOperation subclass: #OBinaryConstantOperation + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OBinaryConstantOperation commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OBinaryConstantOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitBinaryWithConstant: self +! ! + +!OBinaryConstantOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[' , left primitivePrintString , ' ' , name , ' ' + , right primitivePrintString + , ']' +! ! + +!OBinaryConstantOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isBinaryConstantOperation + ^true +! ! + +!OBinaryConstantOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + aBlock value: left +! ! + +!OBinaryConstantOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^(names at: left ifAbsent: 'missing') , ' ' , name , ' ' , right printString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OBinaryConstantOperation class' category: #IR! +OBinaryConstantOperation class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OBinaryOperation.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OBinaryOperation.Class.st new file mode 100644 index 00000000..6cb17930 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OBinaryOperation.Class.st @@ -0,0 +1,96 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OBinaryOperation category: #IR! +OPrimitiveOperation subclass: #OBinaryOperation + instanceVariableNames: 'left right' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OBinaryOperation commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OBinaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: named + ^named == #left ifTrue: [left] ifFalse: [right] +! ! + +!OBinaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: operandName put: instruction + operandName = #left + ifTrue: [left := instruction] + ifFalse: [right := instruction] +! ! + +!OBinaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +invertOperation + name == #'<' ifTrue: [^name := #'>']. + name == #'<=' ifTrue: [^name := #'>=']. + name == #'>' ifTrue: [^name := #'<']. + name == #'>=' ifTrue: [^name := #'<=']. + name == #'==' ifTrue: [^name]. + self halt +! ! + +!OBinaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +left + ^left +! ! + +!OBinaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +left: anInstruction + left := anInstruction +! ! + +!OBinaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +negateOperation + name == #'<' ifTrue: [^name := #'>=']. + name == #'<=' ifTrue: [^name := #'>']. + name == #'>' ifTrue: [^name := #'<=']. + name == #'>=' ifTrue: [name := #'<'] +! ! + +!OBinaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +right + ^right +! ! + +!OBinaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +right: anInstruction + right := anInstruction +! ! + +!OBinaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +swapOperands + | temp | + left removeUse: self. + right removeUse: self. + temp := left. + left := right. + right := temp. + left addUse: self at: #left. + right addUse: self at: #right +! ! + +!OBinaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^left == anInstruction or: [right == anInstruction] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OBinaryOperation class' category: #IR! +OBinaryOperation class + instanceVariableNames: ''! + +!OBinaryOperation class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +left: left right: right name: selector + ^self new + left: left; + right: right; + name: selector +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OBinaryVariableOperation.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OBinaryVariableOperation.Class.st new file mode 100644 index 00000000..351c46d8 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OBinaryVariableOperation.Class.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OBinaryVariableOperation category: #IR! +OBinaryOperation subclass: #OBinaryVariableOperation + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OBinaryVariableOperation commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OBinaryVariableOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitBinaryWithVariable: self +! ! + +!OBinaryVariableOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[' , left primitivePrintString , ' ' , name , ' ' + , right primitivePrintString + , ']' +! ! + +!OBinaryVariableOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isBinaryVariableOperation + ^true +! ! + +!OBinaryVariableOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + aBlock value: left. + aBlock value: right +! ! + +!OBinaryVariableOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^(names at: left ifAbsent: 'missing') , ' ' , name , ' ' , (names at: right) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OBinaryVariableOperation class' category: #IR! +OBinaryVariableOperation class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OBlockClosure.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OBlockClosure.Class.st new file mode 100644 index 00000000..a9104e1e --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OBlockClosure.Class.st @@ -0,0 +1,51 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OBlockClosure category: #IR! +OInstruction subclass: #OBlockClosure + instanceVariableNames: 'firstBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OBlockClosure commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OBlockClosure methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock + ^firstBlock +! ! + +!OBlockClosure methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock: basicBlock + firstBlock := basicBlock +! ! + +!OBlockClosure methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +lastBlock + ^firstBlock lastBlock +! ! + +!OBlockClosure methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +lastValue + ^firstBlock lastBlock lastValue +! ! + +!OBlockClosure methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OBlockClosure class' category: #IR! +OBlockClosure class + instanceVariableNames: ''! + +!OBlockClosure class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +containing: initialBlock + ^self new firstBlock: initialBlock +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OComposedLiveRange.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OComposedLiveRange.Class.st new file mode 100644 index 00000000..949e8dd4 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OComposedLiveRange.Class.st @@ -0,0 +1,114 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OComposedLiveRange category: #IR! +OLiveRange subclass: #OComposedLiveRange + instanceVariableNames: 'ranges' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OComposedLiveRange commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +add: range + ranges add: range +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addAll: range + ranges addAll: range +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allDefinitions + ^ranges gather: #allDefinitions +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allUses + ^ranges gather: #allUses +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +anyDefinition + ^ranges last anyDefinition +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +definitionsWithBlocksDo: aBlock + ^ranges do: [:range | range definitionsWithBlocksDo: aBlock] +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +endsAt: operation + ^false +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +expirationPoints + | definitions uses | + definitions := self allDefinitions. + uses := ranges gather: #usesWithBlocks. + ^uses + select: [:use | definitions + noneSatisfy: [:def | def livesAfter: use key orOutOf: use value]] + thenCollect: #key +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + ranges := OrderedCollection new +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isLiveAt: aBlock + ^self allDefinitions + anySatisfy: [:def | def + livesAfter: aBlock firstInstruction prev + orOutOf: aBlock] +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSpilled + ^ranges anySatisfy: #isSpilled +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + | rangesStrings | + rangesStrings := (ranges collect: #printString) gather: [:x | x , String cr]. + aStream nextPutAll: 'CLR: ' , String cr , rangesStrings +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +simpleRanges + ^ranges +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +startsAt: operation + ^ranges anySatisfy: [:range | range startsAt: operation] +! ! + +!OComposedLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesWithBlocksDo: aBlock + ^ranges do: [:range | range usesWithBlocksDo: aBlock] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OComposedLiveRange class' category: #IR! +OComposedLiveRange class + instanceVariableNames: ''! + +!OComposedLiveRange class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OComposedLiveRange initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OConstant.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OConstant.Class.st new file mode 100644 index 00000000..fd36039d --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OConstant.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OConstant category: #IR! +OValue subclass: #OConstant + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OConstant commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OConstant class' category: #IR! +OConstant class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/ODefineArgument.Class.st b/modules/LMR/Nativizer/OCompiler/IR/ODefineArgument.Class.st new file mode 100644 index 00000000..bc769a2f --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/ODefineArgument.Class.st @@ -0,0 +1,66 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ODefineArgument category: #IR! +OInstruction subclass: #ODefineArgument + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!ODefineArgument commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ODefineArgument methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitDefineArgument: self +! ! + +!ODefineArgument methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[define arg ' , name , ']' +! ! + +!ODefineArgument methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isDefineArgument + ^true +! ! + +!ODefineArgument methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^name +! ! + +!ODefineArgument methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aSymbol + name := aSymbol +! ! + +!ODefineArgument methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + +! ! + +!ODefineArgument methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{' , name , '}' +! ! + +!ODefineArgument methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^'define arg ' , name +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ODefineArgument class' category: #IR! +ODefineArgument class + instanceVariableNames: ''! + +!ODefineArgument class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +named: aSymbol + ^self new name: aSymbol +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/ODominatorTree.Class.st b/modules/LMR/Nativizer/OCompiler/IR/ODominatorTree.Class.st new file mode 100644 index 00000000..25a1ee1a --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/ODominatorTree.Class.st @@ -0,0 +1,115 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ODominatorTree category: #IR! +Object subclass: #ODominatorTree + instanceVariableNames: 'block dominators dominated' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!ODominatorTree commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addDominated: aTree + dominated add: aTree +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allImmediateDominators + | result remaining | + result := Dictionary new. + remaining := OrderedCollection with: self. + [remaining isEmpty] whileFalse: [| current | + current := remaining removeLast. + current dominated do: [:child | result at: child block put: current block]. + remaining addAll: current dominated]. + ^result +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +block + ^block +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +block: aBasicBlock + block := aBasicBlock +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dominated + ^dominated +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dominators + ^dominators +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dominators: aTreeCollection + dominators := aTreeCollection +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + dominated := OrderedCollection new +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isImmediateDominatorOf: aBasicBlock + ^block == self or: [block successors includes: aBasicBlock] +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +noticeDominators + dominators + select: [:tree | tree isImmediateDominatorOf: self] + thenDo: [:dominator | dominator addDominated: self] +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printAtLevel: level on: aStream + level > 8 ifTrue: [self halt]. + level timesRepeat: [aStream nextPutAll: '--']. + aStream nextPutAll: block name , String cr. + dominated + reject: [:tree | tree == self] + thenDo: [:tree | tree printAtLevel: level + 1 on: aStream] +! ! + +!ODominatorTree methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + self printAtLevel: 1 on: aStream +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ODominatorTree class' category: #IR! +ODominatorTree class + instanceVariableNames: ''! + +!ODominatorTree class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +from: root with: aBlocksCollection dominators: dominators + | trees | + trees := Array + withAll: (aBlocksCollection collect: [:block | self new block: block]). + (dominators copyFrom: 2) + withIndexDo: [:dominator :correspondingIndex | | imm child | + imm := trees at: dominator. + child := trees at: correspondingIndex + 1. + imm addDominated: child]. + ^trees first +! ! + +!ODominatorTree class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +ODominatorTree initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OEndInstruction.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OEndInstruction.Class.st new file mode 100644 index 00000000..1a9925e2 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OEndInstruction.Class.st @@ -0,0 +1,87 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OEndInstruction category: #IR! +OInstruction subclass: #OEndInstruction + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OEndInstruction commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: aVisitor + +! ! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addLast: anInstruction + prev next: anInstruction. + anInstruction prev: prev. + anInstruction next: self. + prev := anInstruction +! ! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +detect: aBlock ifNone: absentBlock + ^absentBlock value +! ! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +do: aBlock + +! ! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasNext + ^false +! ! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isEnd + ^true +! ! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +last + ^prev +! ! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printForwardOn: aStream + +! ! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printForwardOn: aStream using: names + +! ! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + " + prev printBackwardOn: aStream + " + +! ! + +!OEndInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replace: one with: other + +! ! + +!OEndInstruction methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +reverseDo: aBlock + prev reverseDo: aBlock +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OEndInstruction class' category: #IR! +OEndInstruction class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OInstruction.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OInstruction.Class.st new file mode 100644 index 00000000..b64a29ae --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OInstruction.Class.st @@ -0,0 +1,578 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OInstruction category: #IR! +OValue subclass: #OInstruction + instanceVariableNames: 'prev next firstUse' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OInstruction commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: aVisitor + | following current | + current := self. + [ + following := current next. + current isEnd] + whileFalse: [ + current basicAcceptVisitor: aVisitor. + current := current next ifNil: [following]] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addLast: anInstruction + next addLast: anInstruction +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addNext: anInstruction + ^self afterInsert: anInstruction +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addUse: new + firstUse ifNil: [firstUse := new] ifNotNil: [firstUse addUse: new] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addUse: user at: name + | operand | + operand := OOperand at: user named: name. + self addUse: operand +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +afterInsert: anInstruction + anInstruction next: next. + anInstruction prev: self. + next prev: anInstruction. + next := anInstruction +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +afterInsertAll: anInstruction + | last | + last := anInstruction last. + last next: next. + anInstruction prev: self. + next prev: last. + next := anInstruction +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allUses + | result following | + result := OrderedCollection new. + following := firstUse. + [following notNil] whileTrue: [ + result add: following. + following := following nextUse]. + ^result +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assureBoundBy: binder + +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: name + ^self subclassResponsibility +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: operandName put: instruction + ^self subclassResponsibility +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^self primitivePrintString +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +beforeInsert: anInstruction + anInstruction next: self. + anInstruction prev: prev. + prev next: anInstruction. + prev := anInstruction +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +beforeInsertAll: anInstruction + | last | + last := anInstruction "last". + last next: self. + anInstruction prev: prev. + prev next: anInstruction. + prev := last. + self shouldBeImplemented +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +cutFollowing + | end | + end := OEndInstruction new. + end prev: self. + next := end. + ^end +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +cutPrevious + | begin | + begin := OBeginInstruction new. + begin next: self. + prev := begin. + ^begin +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +detect: aBlock + ^self detect: aBlock ifNone: [self errorAbsentObject] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +detect: aBlock ifNone: absentBlock + (aBlock value: self) + ifTrue: [^self] + ifFalse: [^next detect: aBlock ifNone: absentBlock] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dissolve + self untie; operandsDo: [:instruction | instruction removeUse: self] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dissolveIfUnused + self isUsed ifFalse: [self dissolve] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dissolveReplacingWith: anInstruction + prev next: anInstruction. + next prev: anInstruction. + anInstruction prev: prev. + anInstruction next: next. + prev := next := nil. + self operandsDo: [:instruction | instruction removeUse: self]. + self replaceAllUsesWith: anInstruction +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +dissolveReplacingWithAll: instructions + | last | + last := instructions last. + prev next: instructions. + instructions prev: prev. + last next: next. + next prev: last. + prev := next := nil. + self operandsDo: [:instruction | instruction removeUse: self]. + self replaceAllUsesWith: last +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +do: aBlock + | following | + following := next. + aBlock value: self. + next ifNil: [following do: aBlock] ifNotNil: [next do: aBlock] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstNonPhi + | current | + current := self. + [current isPhi] whileTrue: [current := current next]. + ^current +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstUse + ^firstUse +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasNext + ^true +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasPrev + ^true +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertCopyBefore: anInstruction + | copy | + copy := self newCopy. + anInstruction beforeInsert: copy. + ^copy +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPushBefore: anInstruction + | push | + push := OUnaryOperation receiver: self name: #push. + self addUse: push at: #receiver. + anInstruction beforeInsert: push. + ^push +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isBlockStart + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isConditionalJump + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isConstant + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isDefineArgument + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isDefinedAt: aBlock + aBlock instructionsDo: [:instruction | instruction == self ifTrue: [^true]]. + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isEnd + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isGenericMessage + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInstruction + ^true +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isJump + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isLoadImplicit + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMessageSend + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPhi + ^false +! ! + +!OInstruction methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPrimitiveOperation + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isReturn + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isStoreVariable + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUnconditionalJump + ^self isJump andNot: [self isConditionalJump] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUsed + ^firstUse notNil +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUsedJustOnce + ^firstUse notNil and: [firstUse nextUse isNil] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUsedOnlyBy: instruction + ^self isUsedJustOnce and: [firstUse user == instruction] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +last + ^next last +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +lastPhi + | current | + current := self. + [current next isPhi] whileTrue: [current := current next]. + ^current +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +lastValue + | last | + last := self last. + ^last isJump ifTrue: [last prev] ifFalse: [last] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +livesAfter: anInstruction + anInstruction + nextDetect: [:instruction | instruction usesResultOf: self] + ifNone: [^false]. + ^true +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +livesAfter: anInstruction orOutOf: aBasicBlock + ^(self livesAfter: anInstruction) or: [self livesOutOfBlock: aBasicBlock] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +livesOutOfBlock: aBasicBlock + aBasicBlock successorsPostOrder + reverseDo: [:block | (block usesResultOf: self) ifTrue: [^true]]. + ^false +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +newCopy + | copy | + copy := OUnaryOperation receiver: self name: #copy. + self addUse: copy at: #receiver. + ^copy +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +next + ^next +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +next: anInstruction + self DENY: (self isJump and: [anInstruction isEnd not]). + next := anInstruction +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextDetect: aBlock ifNone: absentBlock + ^next detect: aBlock ifNone: absentBlock +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operands + | result | + result := OrderedCollection new. + self operandsDo: [:o | result add: o]. + ^result select: #isInstruction +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + self subclassResponsibility +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +prev + ^prev +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +prev: anInstruction + prev := anInstruction +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^self class name +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printBackwardOn: aStream + aStream size > 1000 ifTrue: [ + aStream nextPutAll: '...'. + ^self]. + prev printBackwardOn: aStream. + aStream nextPutAll: self basicPrintString; cr +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printForwardOn: aStream + aStream size > 100000 ifTrue: [ + aStream nextPutAll: '...'. + ^self]. + aStream nextPutAll: self basicPrintString; cr. + next printForwardOn: aStream +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printForwardOn: aStream using: names + aStream size > 100000 ifTrue: [ + aStream nextPutAll: '...'. + ^self]. + aStream + nextPutAll: (names at: self) , ' := ' , (self printStringUsing: names); + cr. + next printForwardOn: aStream using: names +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + " + prev printBackwardOn: aStream. + aStrem nextPutAll: '-> ' + " + aStream + nextPutAll: self basicPrintString + " next printForwardOn: aStream cr" +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +realReverseDo: aBlock + | following | + following := prev. + aBlock value: self. + prev + ifNil: [following realReverseDo: aBlock] + ifNotNil: [prev realReverseDo: aBlock] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeUse: instruction + firstUse instruction == instruction + ifTrue: [firstUse := firstUse nextUse] + ifFalse: [firstUse removeUse: instruction] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeUse: instruction at: name + (firstUse instruction == instruction and: [firstUse name = name]) + ifTrue: [firstUse := firstUse nextUse] + ifFalse: [firstUse removeUse: instruction at: name] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceAllUsesWith: anInstruction + self == anInstruction ifTrue: [^self]. + firstUse ifNotNil: [ + firstUse replaceAllUsesWith: anInstruction. + anInstruction addUse: firstUse. + firstUse := nil] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceOperand: name with: instruction + | previous | + previous := self atOperand: name. + previous removeUse: self. + self atOperand: name put: instruction. + instruction addUse: self at: name +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceUsesOf: value with: instruction + self operandsDo: [:operand | + operand = value ifTrue: [ + operand + usesDo: [:use | use user = self + ifTrue: [use disolveReplacingWith: instruction]]]] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceWithCopyOf: value + | instruction | + instruction := ((value isUsedOnlyBy: self) andNot: [value isPhi]) + ifTrue: [value untie] + ifFalse: [value newCopy]. + self dissolveReplacingWith: instruction. + ^instruction +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +reverseDo: aBlock + | following | + following := prev. + aBlock value: self. + prev + ifNil: [following reverseDo: aBlock] + ifNotNil: [prev reverseDo: aBlock] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +targets + ^OrderedCollection new +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +untie + prev next: next. + next prev: prev. + prev := next := nil +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateUser: instruction named: oldName with: newName + self usesDo: [:use | + (use instruction == instruction and: [use name == oldName]) + ifTrue: [use name: newName]] +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +useDistanceTo: value + | count | + count := 0. + self do: [:instruction | + (instruction usesResultOf: value) ifTrue: [^count]. + count := count + 1]. + ^Number infinity +! ! + +!OInstruction methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesDo: aBlock + firstUse ifNotNil: [firstUse usesDo: aBlock] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OInstruction class' category: #IR! +OInstruction class + instanceVariableNames: ''! + +!OInstruction class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +empty + | begin last | + begin := OBeginInstruction new. + last := OEndInstruction new. + begin next: last. + last prev: begin. + ^begin +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OJump.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OJump.Class.st new file mode 100644 index 00000000..16b7402f --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OJump.Class.st @@ -0,0 +1,81 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OJump category: #IR! +OInstruction subclass: #OJump + instanceVariableNames: 'target' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OJump commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OJump methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitJump: self +! ! + +!OJump methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[jump to ' , target name , ']' +! ! + +!OJump methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isJump + ^true +! ! + +!OJump methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + +! ! + +!OJump methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{jump}' +! ! + +!OJump methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^'jump to ' , (names at: target) +! ! + +!OJump methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +retargetFrom: aBasicBlock to: otherBasicBlock + target := otherBasicBlock +! ! + +!OJump methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +target + ^target +! ! + +!OJump methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +target: aBasicBlock + target := aBasicBlock +! ! + +!OJump methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +targets + ^OrderedCollection with: target +! ! + +!OJump methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OJump class' category: #IR! +OJump class + instanceVariableNames: ''! + +!OJump class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +to: aDestination + ^self new target: aDestination +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OJumpConditional.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OJumpConditional.Class.st new file mode 100644 index 00000000..ba7a42fd --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OJumpConditional.Class.st @@ -0,0 +1,115 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OJumpConditional category: #IR! +OInstruction subclass: #OJumpConditional + instanceVariableNames: 'variable target implicitTarget' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OJumpConditional commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: name + ^variable +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: name put: instruction + variable := instruction +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +implicitTarget + ^implicitTarget +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +implicitTarget: aBasicBlock + implicitTarget := aBasicBlock +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isConditionalJump + ^true +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isJump + ^true +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + aBlock value: variable +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceWithUnconditional: condition in: basicBlock + | fixed removed jump | + self isJumpTrue == condition + ifTrue: [ + fixed := target. + removed := implicitTarget] + ifFalse: [ + fixed := implicitTarget. + removed := target]. + jump := OJump to: fixed. + self dissolveReplacingWith: jump. + removed fullyRemovePredecessor: basicBlock +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +retargetFrom: aBasicBlock to: otherBasicBlock + target == aBasicBlock ifTrue: [target := otherBasicBlock]. + implicitTarget == aBasicBlock ifTrue: [implicitTarget := otherBasicBlock] +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +target + ^target +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +target: aBasicBlock + target := aBasicBlock +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +targets + ^OrderedCollection with: implicitTarget with: target +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^variable == anInstruction +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +variable + ^variable +! ! + +!OJumpConditional methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +variable: operand + variable := operand +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OJumpConditional class' category: #IR! +OJumpConditional class + instanceVariableNames: ''! + +!OJumpConditional class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +variable: operation target: explicitTarget implicitTarget: implicitTarget + ^self new + variable: operation; + target: explicitTarget; + implicitTarget: implicitTarget +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OJumpFalse.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OJumpFalse.Class.st new file mode 100644 index 00000000..44a36a6b --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OJumpFalse.Class.st @@ -0,0 +1,57 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OJumpFalse category: #IR! +OJumpConditional subclass: #OJumpFalse + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OJumpFalse commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OJumpFalse methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitJumpFalse: self +! ! + +!OJumpFalse methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[jump false ' , variable primitivePrintString , ' to ' , target name + , ' or fall to ' + , implicitTarget name + , ']' +! ! + +!OJumpFalse methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isJumpFalse + ^true +! ! + +!OJumpFalse methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isJumpTrue + ^false +! ! + +!OJumpFalse methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{jump false}' +! ! + +!OJumpFalse methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^'jump false ' , (names at: variable ifAbsent: ['missing']) , ' to ' + , (names at: target ifAbsent: 'missing') + , ' or fall to ' + , (names at: implicitTarget ifAbsent: 'missing') +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OJumpFalse class' category: #IR! +OJumpFalse class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OJumpTrue.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OJumpTrue.Class.st new file mode 100644 index 00000000..1e7ec23a --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OJumpTrue.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OJumpTrue category: #IR! +OJumpConditional subclass: #OJumpTrue + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OJumpTrue commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OJumpTrue methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitJumpTrue: self +! ! + +!OJumpTrue methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[jump true ' , variable primitivePrintString , ' to ' , target name + , ' or fall to ' + , implicitTarget name + , ']' +! ! + +!OJumpTrue methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isJumpFalse + ^false +! ! + +!OJumpTrue methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isJumpTrue + ^true +! ! + +!OJumpTrue methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{jump true}' +! ! + +!OJumpTrue methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^'jump true ' , (names at: variable) , ' to ' , (names at: target) + , ' or fall to ' + , (names at: implicitTarget) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OJumpTrue class' category: #IR! +OJumpTrue class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OLiveRange.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OLiveRange.Class.st new file mode 100644 index 00000000..82014831 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OLiveRange.Class.st @@ -0,0 +1,32 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OLiveRange category: #IR! +Object subclass: #OLiveRange + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OLiveRange commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OLiveRange methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUsedBy: anInstruction + ^self allDefinitions + anySatisfy: [:definition | anInstruction usesResultOf: definition] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OLiveRange class' category: #IR! +OLiveRange class + instanceVariableNames: ''! + +!OLiveRange class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OLoadConstant.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OLoadConstant.Class.st new file mode 100644 index 00000000..ae58b9d2 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OLoadConstant.Class.st @@ -0,0 +1,78 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OLoadConstant category: #IR! +OInstruction subclass: #OLoadConstant + instanceVariableNames: 'constant' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OLoadConstant commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OLoadConstant methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitLoadConstant: self +! ! + +!OLoadConstant methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[load cst ' , constant printString , ']' +! ! + +!OLoadConstant methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isConstant + ^true +! ! + +!OLoadConstant methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +newCopy + ^self class valued: constant +! ! + +!OLoadConstant methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + constant isInstruction ifTrue: [ + self halt. + aBlock value: constant] +! ! + +!OLoadConstant methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{' , constant printString , '}' +! ! + +!OLoadConstant methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^'load cst ' , constant printString +! ! + +!OLoadConstant methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^false +! ! + +!OLoadConstant methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +value + ^constant +! ! + +!OLoadConstant methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +value: value + constant := value +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OLoadConstant class' category: #IR! +OLoadConstant class + instanceVariableNames: ''! + +!OLoadConstant class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +valued: value + ^self new value: value +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OLoadImplicit.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OLoadImplicit.Class.st new file mode 100644 index 00000000..a5189419 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OLoadImplicit.Class.st @@ -0,0 +1,94 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OLoadImplicit category: #IR! +OInstruction subclass: #OLoadImplicit + instanceVariableNames: 'name source' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OLoadImplicit commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: operandName put: instruction + source := instruction +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitLoadImplicit: self +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[load implicit #' , name printString , ']' +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isLoadImplicit + ^true +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^name +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aSymbol + name := aSymbol +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + source isInstruction ifTrue: [aBlock value: source] +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + " + ^'<#' , source value printString , '>' + " + ^'{#' , name printString , '}' +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^'#' , name printString +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +source + ^source +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +source: operand + source := operand +! ! + +!OLoadImplicit methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OLoadImplicit class' category: #IR! +OLoadImplicit class + instanceVariableNames: ''! + +!OLoadImplicit class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +named: aSymbol + ^self new name: aSymbol +! ! + +!OLoadImplicit class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +self + ^self new name: #self +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OMessageSend.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OMessageSend.Class.st new file mode 100644 index 00000000..34bc800f --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OMessageSend.Class.st @@ -0,0 +1,127 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OMessageSend category: #IR! +OInstruction subclass: #OMessageSend + instanceVariableNames: 'receiver selector arguments' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OMessageSend commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +arguments + ^arguments +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +arguments: operands + arguments := operands +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: named + ^named == #receiver ifTrue: [receiver] ifFalse: [arguments at: named] +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: name put: instruction + name = #receiver + ifTrue: [receiver := instruction] + ifFalse: [arguments at: name put: instruction] +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitMessageSend: self +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + | string | + string := arguments size > 0 + ifTrue: [' with: ' + , (arguments gather: [:arg | arg primitivePrintString , ' '])] + ifFalse: ['']. + ^'[send #' , selector , ' to ' , receiver primitivePrintString + , string trimTrailingBlanks + , ']' +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMessageSend + ^true +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + aBlock value: receiver. + arguments do: aBlock +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{#' , selector , '}' +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + | string | + string := arguments size > 0 + ifTrue: [' with: ' + , (arguments gather: [:arg | (names at: arg ifAbsent: ['missing']) , ' '])] + ifFalse: ['']. + ^'send #' , selector , ' to ' , (names at: receiver ifAbsent: ['missing']) + , string trimTrailingBlanks +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver + ^receiver +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver: operand + receiver := operand +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector + ^selector +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector: aSymbol + selector := aSymbol +! ! + +!OMessageSend methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^receiver == anInstruction + or: [arguments anySatisfy: [:argument | argument == anInstruction]] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OMessageSend class' category: #IR! +OMessageSend class + instanceVariableNames: ''! + +!OMessageSend class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver: receiver selector: selector arguments: arguments + ^self new + receiver: receiver; + selector: selector; + arguments: arguments; + yourself +! ! + +!OMessageSend class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector: selector + ^self new selector: selector +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OOperand.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OOperand.Class.st new file mode 100644 index 00000000..deed61fd --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OOperand.Class.st @@ -0,0 +1,128 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OOperand category: #IR! +Object subclass: #OOperand + instanceVariableNames: 'instruction name nextUse' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OOperand commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addUse: anOperand + self DENY: self == anOperand. + nextUse ifNil: [nextUse := anOperand] ifNotNil: [nextUse addUse: anOperand] +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +asOperand + self halt +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +definition + ^instruction atOperand: name +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +disolveReplacingWith: otherInstruction + self definition removeUse: instruction. + instruction atOperand: name put: otherInstruction. + otherInstruction addUse: instruction at: name +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instruction + ^instruction +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instruction: anInstruction + instruction := anInstruction +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^name +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: operandName + name := operandName +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextUse + ^nextUse +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream + nextPutAll: '[op #' , name printString , '@' , instruction printString + , ']' +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeUse: anInstruction + nextUse instruction == anInstruction + ifTrue: [nextUse := nextUse nextUse] + ifFalse: [nextUse removeUse: anInstruction] +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeUse: anInstruction at: aName + (nextUse instruction == anInstruction and: [nextUse name = aName]) + ifTrue: [nextUse := nextUse nextUse] + ifFalse: [nextUse removeUse: anInstruction at: aName] +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceAllUsesWith: otherInstruction + self replaceUseWith: otherInstruction. + nextUse ifNotNil: [nextUse replaceAllUsesWith: otherInstruction] +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceUseWith: otherInstruction + self DENY: otherInstruction class == OOperand. + instruction atOperand: name put: otherInstruction +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +user + ^instruction +! ! + +!OOperand methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesDo: aBlock + aBlock value: self. + nextUse ifNotNil: [nextUse usesDo: aBlock] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OOperand class' category: #IR! +OOperand class + instanceVariableNames: ''! + +!OOperand class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: anInstruction named: operandName + ^self new instruction: anInstruction; name: operandName +! ! + +!OOperand class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +valued: anInstruction + ^self new value: anInstruction +! ! + +!OOperand class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +valued: anInstruction in: containingInstruction + ^self new value: anInstruction; instruction: containingInstruction +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OPhi.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OPhi.Class.st new file mode 100644 index 00000000..1fe07337 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OPhi.Class.st @@ -0,0 +1,207 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OPhi category: #IR! +OInstruction subclass: #OPhi + instanceVariableNames: 'variables blocks' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OPhi commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addVariable: value from: block + self DENY: (blocks includes: block). + variables add: value. + blocks add: block. + value addUse: self at: block +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: name + | index | + index := blocks indexOf: name. + ^variables at: index +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: name put: instruction + | index | + index := blocks indexOf: name. + variables at: index put: instruction +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitPhi: self +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + | sources | + sources := variables size > 0 + ifTrue: [ + (variables + with: blocks + collect: [:var :block | block name , '->' , var primitivePrintString]) + gather: [:x | x , ', ']] + ifFalse: [' ']. + ^'[phi(' , (sources allButLast: 2) , ')]' +! ! + +!OPhi methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +blocks + ^blocks +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +blocks: aCollection + blocks := aCollection +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +clearVariables + variables := OrderedCollection new. + blocks := OrderedCollection new +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + variables := OrderedCollection new. + blocks := OrderedCollection new +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPhi + ^true +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + variables do: aBlock +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{#phi}' +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + | sources | + sources := variables size > 0 + ifTrue: [ + (variables + with: blocks + collect: [:var :block | (names at: block ifAbsent: ['missing']) , '->' + , (names at: var ifAbsent: ['missing'])]) + gather: [:x | x , ', ']] + ifFalse: [' ']. + ^'phi(' , (sources allButLast: 2) , ')' +! ! + +!OPhi methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +realReverseDo: aBlock + +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeBlock: removed + | index variable | + index := blocks indexOf: removed. + variable := variables at: index. + variable removeUse: self at: removed. + variables removeIndex: index. + blocks removeIndex: index. + variables size = 1 ifTrue: [ + self replaceAllUsesWith: variables first; dissolve. + ^variables first]. + ^self +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeVariable: removed at: index + | block | + block := blocks at: index. + removed removeUse: self at: block. + variables removeIndex: index. + blocks removeIndex: index. + variables size = 1 + ifTrue: [self replaceAllUsesWith: variables first; dissolve] +! ! + +!OPhi methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +replaceBlock: original with: new + blocks withIndexDo: [:block :i | | source | + block == original ifTrue: [ + source := variables at: i. + source updateUser: self named: original with: new. + blocks at: i put: new]] +! ! + +!OPhi methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +shortPrintString + | sources | + sources := variables size > 0 + ifTrue: [(variables collect: #primitivePrintString) gather: [:x | x , ', ']] + ifFalse: [' ']. + ^'[phi(' , (sources allButLast: 2) , ')]' +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +sortAfter: predecessors + | indices | + indices := predecessors collect: [:pred | blocks indexOf: pred]. + variables := indices collect: [:index | variables at: index]. + blocks := predecessors copy +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^variables includes: anInstruction +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +variables + ^variables +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +variables: aCollection + variables := aCollection +! ! + +!OPhi methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +variablesWithBlocksDo: aBlock + variables with: blocks do: aBlock +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OPhi class' category: #IR! +OPhi class + instanceVariableNames: ''! + +!OPhi class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + +!OPhi class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +with: operation1 from: block1 with: operation2 from: block2 + ^self new + addVariable: operation1 from: block1; + addVariable: operation2 from: block2 +! ! + +!OPhi class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +withAll: operations in: blocks + ^self new variables: operations; blocks: blocks copy +! ! + + +OPhi initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OPrimitiveOperation.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OPrimitiveOperation.Class.st new file mode 100644 index 00000000..a94feaad --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OPrimitiveOperation.Class.st @@ -0,0 +1,51 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OPrimitiveOperation category: #IR! +OInstruction subclass: #OPrimitiveOperation + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OPrimitiveOperation commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OPrimitiveOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^self primitivePrintString +! ! + +!OPrimitiveOperation methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPrimitiveOperation + ^true +! ! + +!OPrimitiveOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^name +! ! + +!OPrimitiveOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: selector + name := selector +! ! + +!OPrimitiveOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{#' , name , '}' +! ! + +!OPrimitiveOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^self primitivePrintString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OPrimitiveOperation class' category: #IR! +OPrimitiveOperation class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OReadVariable.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OReadVariable.Class.st new file mode 100644 index 00000000..e15769d6 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OReadVariable.Class.st @@ -0,0 +1,71 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OReadVariable category: #IR! +OUseVariable subclass: #OReadVariable + instanceVariableNames: 'source' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OReadVariable commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OReadVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: name put: instruction + source := instruction +! ! + +!OReadVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitReadVariable: self +! ! + +!OReadVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[read var #' , (binding ifNil: ['#error'] ifNotNil: [binding name]) , ']' +! ! + +!OReadVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + source ifNotNil: [aBlock value: source] +! ! + +!OReadVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{#' , (binding ifNil: ['#error'] ifNotNil: [binding name]) , ' read}' +! ! + +!OReadVariable methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^self basicPrintString +! ! + +!OReadVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +source + ^source +! ! + +!OReadVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +source: anInstruction + source := anInstruction +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OReadVariable class' category: #IR! +OReadVariable class + instanceVariableNames: ''! + +!OReadVariable class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +binding: binding + ^self new binding: binding +! ! + +!OReadVariable class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +source: identifier + ^self new source: identifier +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OReturn.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OReturn.Class.st new file mode 100644 index 00000000..8fa9d18e --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OReturn.Class.st @@ -0,0 +1,94 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OReturn category: #IR! +OInstruction subclass: #OReturn + instanceVariableNames: 'source frame argumentsCount' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OReturn commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +argumentsCount + ^argumentsCount +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +argumentsCount: anInteger + argumentsCount := anInteger +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: name + ^name == #source ifTrue: [source] ifFalse: [frame] +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: name put: instruction + ^name == #source + ifTrue: [source := instruction] + ifFalse: [frame := instruction] +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitReturn: self +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[ret ' , source primitivePrintString , ']' +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +frame: anInstruction + frame := anInstruction +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isReturn + ^true +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + aBlock value: source. + aBlock value: frame +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{ret}' +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^'ret ' , (names at: source ifAbsent: 'missing') , '' +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +source + ^source +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +source: anInstruction + source := anInstruction +! ! + +!OReturn methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^source == anInstruction or: [frame == anInstruction] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OReturn class' category: #IR! +OReturn class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OSimpleLiveRange.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OSimpleLiveRange.Class.st new file mode 100644 index 00000000..f6c0d2a9 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OSimpleLiveRange.Class.st @@ -0,0 +1,141 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OSimpleLiveRange category: #IR! +OLiveRange subclass: #OSimpleLiveRange + instanceVariableNames: 'definition uses definitionBlock usesBlocks isSpilled' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OSimpleLiveRange commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addUseFrom: operation at: block + uses add: operation -> block +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allDefinitions + ^OrderedCollection with: definition +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allUses + ^uses collect: #key +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +anyDefinition + ^definition +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +beSpilled + isSpilled := true +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +clearUses + uses := OrderedCollection new +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +definedAt: operation in: block + definition := operation. + definitionBlock := block +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +definition: operation + definition := operation +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +definitionAndUses + ^OrderedCollection with: definition -> definitionBlock withAll: uses +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +definitionsWithBlocksDo: aBlock + aBlock value: definition value: definitionBlock +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +endsAt: operation + ^uses isEmpty +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +expirationPoints + | associations | + associations := uses + reject: [:operation | definition + livesAfter: operation key + orOutOf: operation value]. + ^associations collect: #key +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + uses := OrderedCollection new. + isSpilled := false +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isLiveAt: aBlock + ^definition livesAfter: aBlock firstInstruction prev orOutOf: aBlock +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSpilled + ^isSpilled +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUnused + ^uses isEmpty +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: 'LR of: ' , definition printString +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +simpleRanges + ^OrderedCollection with: self +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +startsAt: operation + ^definition == operation +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +uses + ^uses +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesWithBlocks + ^uses +! ! + +!OSimpleLiveRange methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesWithBlocksDo: aBlock + uses + do: [:association | aBlock value: association key value: association value] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OSimpleLiveRange class' category: #IR! +OSimpleLiveRange class + instanceVariableNames: ''! + + +OSimpleLiveRange initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OTemporary.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OTemporary.Class.st new file mode 100644 index 00000000..294f1862 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OTemporary.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OTemporary category: #IR! +OVariable subclass: #OTemporary + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OTemporary commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OTemporary class' category: #IR! +OTemporary class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OTernaryOperation.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OTernaryOperation.Class.st new file mode 100644 index 00000000..3258b22f --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OTernaryOperation.Class.st @@ -0,0 +1,122 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OTernaryOperation category: #IR! +OPrimitiveOperation subclass: #OTernaryOperation + instanceVariableNames: 'receiver left right' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OTernaryOperation commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: named + ^named == #receiver + ifTrue: [receiver] + ifFalse: [named == #left ifTrue: [left] ifFalse: [right]] +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: operandName put: instruction + operandName = #receiver ifTrue: [receiver := instruction] ifFalse: [ + operandName = #left + ifTrue: [left := instruction] + ifFalse: [right := instruction]] +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitTernary: self +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[' + , (receiver isInstruction + ifTrue: [receiver primitivePrintString] + ifFalse: [receiver printString]) , ' ' , name , ' ' + , left primitivePrintString + , ', ' + , right primitivePrintString + , ']' +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isTernaryOperation + ^true +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +left + ^left +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +left: value + left := value +! ! + +!OTernaryOperation methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + aBlock value: receiver. + left isInstruction ifTrue: [aBlock value: left]. + aBlock value: right +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^(receiver isInstruction + ifTrue: [names at: receiver] + ifFalse: [receiver printString]) , ' ' , name , ' ' + , (left isInstruction ifTrue: [names at: left] ifFalse: [left printString]) + , ', ' + , (right isInstruction + ifTrue: [names at: right] + ifFalse: [right printString]) +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver + ^receiver +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver: value + receiver := value +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +right + ^right +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +right: value + right := value +! ! + +!OTernaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^receiver == anInstruction + or: [left == anInstruction or: [right == anInstruction]] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OTernaryOperation class' category: #IR! +OTernaryOperation class + instanceVariableNames: ''! + +!OTernaryOperation class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver: receiver left: left right: right name: selector + ^self new + receiver: receiver; + left: left; + right: right; + name: selector +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OTiling.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OTiling.Class.st new file mode 100644 index 00000000..42b460f3 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OTiling.Class.st @@ -0,0 +1,68 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OTiling category: #IR! +Object subclass: #OTiling + instanceVariableNames: 'action cost used instruction' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OTiling commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OTiling methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +beUsed + used := true +! ! + +!OTiling methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + used := false +! ! + +!OTiling methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instruction + ^instruction +! ! + +!OTiling methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instruction: anInstruction + instruction := anInstruction +! ! + +!OTiling methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUsed + ^used = true +! ! + +!OTiling methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: self printString +! ! + +!OTiling methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printString + ^'' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OTiling class' category: #IR! +OTiling class + instanceVariableNames: ''! + +!OTiling class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +for: instruction + ^self new instruction: instruction +! ! + +!OTiling class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OTiling initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OUnaryOperation.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OUnaryOperation.Class.st new file mode 100644 index 00000000..3183d788 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OUnaryOperation.Class.st @@ -0,0 +1,81 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OUnaryOperation category: #IR! +OPrimitiveOperation subclass: #OUnaryOperation + instanceVariableNames: 'receiver' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OUnaryOperation commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OUnaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: operandName + ^receiver +! ! + +!OUnaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: operandName put: instruction + receiver := instruction +! ! + +!OUnaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitUnary: self +! ! + +!OUnaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + ^'[' + , (receiver isInstruction + ifTrue: [receiver primitivePrintString] + ifFalse: [receiver printString]) , ' ' , name , ']' +! ! + +!OUnaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUnaryOperation + ^true +! ! + +!OUnaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + aBlock value: receiver +! ! + +!OUnaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + ^(receiver isInstruction + ifTrue: [names at: receiver] + ifFalse: [receiver printString]) , ' ' , name +! ! + +!OUnaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver + ^receiver +! ! + +!OUnaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver: operation + receiver := operation +! ! + +!OUnaryOperation methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anInstruction + ^receiver == anInstruction +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OUnaryOperation class' category: #IR! +OUnaryOperation class + instanceVariableNames: ''! + +!OUnaryOperation class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver: receiver name: aString + ^self new name: aString; receiver: receiver +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OUseVariable.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OUseVariable.Class.st new file mode 100644 index 00000000..2f125701 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OUseVariable.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OUseVariable category: #IR! +OInstruction subclass: #OUseVariable + instanceVariableNames: 'binding' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OUseVariable commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OUseVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +binding + ^binding +! ! + +!OUseVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +binding: aBinding + binding := aBinding +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OUseVariable class' category: #IR! +OUseVariable class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OValue.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OValue.Class.st new file mode 100644 index 00000000..08471ea7 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OValue.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OValue category: #IR! +Object subclass: #OValue + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OValue commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OValue class' category: #IR! +OValue class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OVariable.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OVariable.Class.st new file mode 100644 index 00000000..42b3cc23 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OVariable.Class.st @@ -0,0 +1,47 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OVariable category: #IR! +Object subclass: #OVariable + instanceVariableNames: 'binding' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OVariable commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assureBoundBy: aVariableBinder + binding isPoolVariableBinding + ifTrue: [^aVariableBinder bindPoolVariable: self with: binding]. + binding isTemporary + ifTrue: [^aVariableBinder bindTemporary: self with: binding]. + (binding isLiteral or: [binding isPseudo]) + ifTrue: [^aVariableBinder bindSpecial: self with: binding]. + self halt +! ! + +!OVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +binding: aBinding + binding := aBinding +! ! + +!OVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isConstant + ^false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OVariable class' category: #IR! +OVariable class + instanceVariableNames: ''! + +!OVariable class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +source: aParseNode + ^self new binding: aParseNode binding +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/OWriteVariable.Class.st b/modules/LMR/Nativizer/OCompiler/IR/OWriteVariable.Class.st new file mode 100644 index 00000000..0e81d4d6 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/OWriteVariable.Class.st @@ -0,0 +1,89 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OWriteVariable category: #IR! +OUseVariable subclass: #OWriteVariable + instanceVariableNames: 'source' + classVariableNames: '' + poolDictionaries: '' + category: 'IR'! +!OWriteVariable commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +atOperand: name put: instruction + source := instruction +! ! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicAcceptVisitor: aVisitor + ^aVisitor visitWriteVariable: self +! ! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicPrintString + | sourceString | + sourceString := source isInstruction + ifTrue: [source primitivePrintString] + ifFalse: [self halt]. + ^'[write ' , self name printString , ' with ' , sourceString , ' ]' +! ! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isStoreVariable + ^true +! ! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^binding name +! ! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +operandsDo: aBlock + aBlock value: source +! ! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^'{write ' , self name printString , ' }' +! ! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printStringUsing: names + | sourceString | + sourceString := source isInstruction + ifTrue: [names at: source] + ifFalse: [self halt]. + ^'write ' , self name printString , ' with ' , sourceString +! ! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +source + ^source +! ! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +source: operation + source := operation +! ! + +!OWriteVariable methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesResultOf: anOperand + ^source == anOperand +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OWriteVariable class' category: #IR! +OWriteVariable class + instanceVariableNames: ''! + +!OWriteVariable class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +binding: aBinding valued: operation + ^self new binding: aBinding; source: operation +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/IR/Object.Extension.st b/modules/LMR/Nativizer/OCompiler/IR/Object.Extension.st new file mode 100644 index 00000000..2cab84a5 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/IR/Object.Extension.st @@ -0,0 +1,29 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Object methodsFor: '*IR' stamp: 'KenD 28/Jun/2026 13:27:39'! +isBinaryConstantOperation + ^false +! ! + +!Object methodsFor: '*IR' stamp: 'KenD 28/Jun/2026 13:27:39'! +isBinaryVariableOperation + ^false +! ! + +!Object methodsFor: '*IR' stamp: 'KenD 28/Jun/2026 13:27:39'! +isTernaryOperation + ^false +! ! + +!Object methodsFor: '*IR' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUnaryOperation + ^false +! ! + +!Object methodsFor: '*IR' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitivePrintString + ^self printString +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/NativizationEnvironment.Extension.st b/modules/LMR/Nativizer/OCompiler/NativizationEnvironment.Extension.st new file mode 100644 index 00000000..af720a79 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/NativizationEnvironment.Extension.st @@ -0,0 +1,61 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!NativizationEnvironment methodsFor: '*OCompiler' stamp: 'KenD 28/Jun/2026 13:27:39'! +optimizingNativizer + ^OptimizingNativizer +! ! + +!NativizationEnvironment methodsFor: '*OCompiler' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldOptimize: method + method isDebuggable ifTrue: [^false]. + method isCallback ifTrue: [^false]. + (method classBinding == Object + and: [SendSite isUndermethod: method selector]) + ifTrue: [^true]. + (method classBinding == ProtoObject + and: [#(behavior class primitiveAt:) includes: method selector]) + ifTrue: [^true]. + (method classBinding == Object and: [ + #(at: at:put: basicByteAt: basicByteAt:put: byteAtValid: byteAtValid:put: + basicObjectAt: basicObjectAt:put: primitiveAt:put: replaceBytesForwardFrom:to:with:startingAt:) + includes: method selector]) + ifTrue: [^true]. + (method classBinding == Array + and: [#(at: at:put:) includes: method selector]) + ifTrue: [^true]. + (method classBinding == SendSite and: [ + #(_dispatchOn: _dispatchOn:startingAt: _dispatchDebuggableOn: _dispatchDebuggableOn:startingAt:) + includes: method selector]) + ifTrue: [^true]. + (method classBinding == Species + and: [#(allocate:size: primitiveNew primitiveNew: instSize + primitiveNewBytes: primitiveNewPointers:) + includes: method selector]) + ifTrue: [^true]. + (method classBinding == Float class + and: [#(basicNew new) includes: method selector]) + ifTrue: [^true]. + (method classBinding == CompiledBlock + and: [#(argumentCount arity blockCode method) includes: method selector]) + ifTrue: [^true]. + (method classBinding == Closure + and: [#(value value: value:value:) includes: method selector]) + ifTrue: [^true]. + (method classBinding == CompiledMethod + and: [#(at: blockCount isNativized) includes: method selector]) + ifTrue: [^true]. + (method classBinding == String + and: [#(at: at:put: byteAt: byteAt:put:) includes: method selector]) + ifTrue: [^true]. + (method classBinding == GCSpace and: [ + #(lockedAllocateIfPossible: lockedAllocateUnsafe: shallowCopy:) + includes: method selector]) + ifTrue: [^true]. + (method classBinding == Memory + and: [#(shallowCopy:) includes: method selector]) + ifTrue: [^true]. + ^false +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/Object.Extension.st b/modules/LMR/Nativizer/OCompiler/Object.Extension.st new file mode 100644 index 00000000..da718f1b --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/Object.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Object methodsFor: '*OCompiler' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInstruction + ^false +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingBlockInliner.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingBlockInliner.Class.st new file mode 100644 index 00000000..96bd2da2 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingBlockInliner.Class.st @@ -0,0 +1,197 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingBlockInliner category: #OCompiler! +Object subclass: #OptimizingBlockInliner + instanceVariableNames: 'firstBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingBlockInliner commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +doInline + self inlineInnerBlocksOf: firstBlock +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inline: aMessageSend in: block + ^self performInlinerFor: aMessageSend in: block +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineAnd: message in: block + | closure firstSkipped lastSkipped join | + closure := message arguments first. + firstSkipped := closure firstBlock. + self inlineInnerBlocksOf: firstSkipped. + lastSkipped := firstSkipped lastBlock. + join := block splitAfter: message. + join + insertPhiOf: message receiver + at: block + and: lastSkipped + replacing: message. + block endWithJumpFalseTo: join skipping: firstSkipped if: message receiver. + lastSkipped endWithJumpTo: join. + firstSkipped addPredecessor: block. + join addPredecessor: block; addPredecessor: lastSkipped. + ^join +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineIfFalse: message in: block + | closure firstSkipped lastSkipped join | + closure := message arguments first. + firstSkipped := closure firstBlock. + self inlineInnerBlocksOf: firstSkipped. + lastSkipped := firstSkipped lastBlock. + join := block splitAfter: message. + block endWithJumpTrueTo: join skipping: firstSkipped if: message receiver. + lastSkipped endWithJumpTo: join. + firstSkipped addPredecessor: block. + join addPredecessor: lastSkipped; addPredecessor: block. + message dissolve. + ^join +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineIfTrue: message in: block + | closure firstSkipped lastSkipped join | + closure := message arguments first. + firstSkipped := closure firstBlock. + self inlineInnerBlocksOf: firstSkipped. + lastSkipped := firstSkipped lastBlock. + join := block splitAfter: message. + block endWithJumpFalseTo: join skipping: firstSkipped if: message receiver. + lastSkipped endWithJumpTo: join. + firstSkipped addPredecessor: block. + join addPredecessor: lastSkipped; addPredecessor: block. + message dissolve. + ^join +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineIfTrueifFalse: message in: block + | positive negative firstTrue firstFalse lastTrue lastFalse join | + positive := message arguments first. + negative := message arguments second. + firstTrue := positive firstBlock. + firstFalse := negative firstBlock. + self inlineInnerBlocksOf: firstTrue and: firstFalse. + lastTrue := firstTrue lastBlock. + lastFalse := firstFalse lastBlock. + join := block splitAfter: message. + join insertPhiOf: lastTrue and: lastFalse replacing: message. + block + endWithJumpFalseTo: firstFalse + skipping: firstTrue + if: message receiver. + lastTrue endWithJumpTo: join. + lastFalse endWithJumpTo: join. + firstTrue addPredecessor: block. + firstFalse addPredecessor: block. + join addPredecessor: lastTrue; addPredecessor: lastFalse. + ^join +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineInnerBlocksOf: basicBlock + | currentBlock | + currentBlock := basicBlock. + basicBlock instructionsDo: [:instruction | + (self shouldInline: instruction) + ifTrue: [currentBlock := self inline: instruction in: currentBlock]] +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineInnerBlocksOf: basicBlock1 and: basicBlock2 + self inlineInnerBlocksOf: basicBlock1; inlineInnerBlocksOf: basicBlock2 +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineInnerBlocksOf: basicBlock1 and: basicBlock2 and: basicBlock3 + self + inlineInnerBlocksOf: basicBlock1; + inlineInnerBlocksOf: basicBlock2; + inlineInnerBlocksOf: basicBlock3 +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineOr: message in: block + | closure firstSkipped lastSkipped join | + closure := message arguments first. + firstSkipped := closure firstBlock. + self inlineInnerBlocksOf: firstSkipped. + lastSkipped := firstSkipped lastBlock. + join := block splitAfter: message. + join + insertPhiOf: message receiver + at: block + and: lastSkipped + replacing: message. + block endWithJumpTrueTo: join skipping: firstSkipped if: message receiver. + lastSkipped endWithJumpTo: join. + firstSkipped addPredecessor: block. + join addPredecessor: block; addPredecessor: lastSkipped. + ^join +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inliners + ^#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue: and: or: to:do: whileTrue:) +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineWhileTrue: message in: block + | antecedent consequent firstAntecedent firstConsequent lastAntecedent lastConsequent join | + antecedent := message receiver. + consequent := message arguments first. + firstAntecedent := antecedent firstBlock. + firstConsequent := consequent firstBlock. + self inlineInnerBlocksOf: firstAntecedent and: firstConsequent. + lastAntecedent := firstAntecedent lastBlock. + lastConsequent := firstConsequent lastBlock. + join := block splitAfter: message. + block endWithJumpTo: firstAntecedent. + lastAntecedent + endWithJumpFalseTo: join + skipping: firstConsequent + if: lastAntecedent lastValue. + lastConsequent endWithJumpTo: firstAntecedent. + message dissolve. + firstAntecedent addPredecessor: block; addPredecessor: lastConsequent. + firstConsequent addPredecessor: lastAntecedent. + join addPredecessor: lastAntecedent. + ^join +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: block + firstBlock := block +! ! + +!OptimizingBlockInliner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +performInlinerFor: messageSend in: block + | selector inliner | + selector := messageSend selector asString copyWithout: $:. + inliner := #inline , selector capitalized , ':in:'. + ^self perform: inliner asSymbol with: messageSend with: block +! ! + +!OptimizingBlockInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldInline: anInstruction + ^anInstruction isMessageSend + and: [self inliners includes: anInstruction selector] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingBlockInliner class' category: #OCompiler! +OptimizingBlockInliner class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingBraunAllocator.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingBraunAllocator.Class.st new file mode 100644 index 00000000..da48205c --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingBraunAllocator.Class.st @@ -0,0 +1,449 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingBraunAllocator category: #OCompiler! +Object subclass: #OptimizingBraunAllocator + instanceVariableNames: 'firstBlock currentBlock loops liveness allocationEntry allocationExit distancesExit spillExit currentlyAvailable currentlySpilled temporaries amountOfRegisters scheduledSpills scheduledReloads blocksDone deferredCouplings' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingBraunAllocator commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +activationRecord + ^firstBlock firstInstruction +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocationEntry + ^allocationEntry +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +amountOfRegisters + ^amountOfRegisters +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +amountOfRegisters: amount + amountOfRegisters := amount +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +areEqual: last and: distances + last size = distances size ifFalse: [^false]. + last keysAndValuesDo: [:key :value | | other | + other := distances at: key ifAbsent: [^false]. + other = value ifFalse: [^false]]. + ^true +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +clobbersOneRegister: inst + ^((inst isJump or: [inst isUnaryOperation and: [inst name == #push]]) + or: [inst isTernaryOperation and: [inst name = #_basicAt:put:]]) not +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeEntryRegistersOf: block + (self isLoopHead: block) + ifTrue: [self initLoopHeader: block] + ifFalse: [self initUsual: block] +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeLiveness + liveness := OptimizingLivenessAnalysis new + firstBlock: firstBlock; + loops: loops; + analyzeLiveness +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeLoops + loops := firstBlock allLoops +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeTemporaryIndexes + | index | + index := 1. + scheduledSpills do: [:value | + temporaries at: value put: index. + index := index + 1]. + self activationRecord temporaries: index - 1 +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeUseDistanceOf: instruction number: index using: distances + instruction operandsDo: [:operand | distances at: operand put: index]. + distances removeKey: instruction ifAbsent: [] +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeUseDistances + | distancesEntry changed | + distancesEntry := IdentityDictionary new. + changed := true. + [changed] whileTrue: [ + changed := false. + firstBlock withSuccessorsPostOrder + do: [:block | changed := (self + computeUseDistancesOf: block + using: distancesEntry) + or: changed]] +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeUseDistancesOf: block using: distancesEntry + | distances index length | + distances := IdentityDictionary new. + length := block length. + block successors do: [:succ | | incoming | + incoming := distancesEntry at: succ ifAbsent: [Dictionary new]. + incoming keysAndValuesDo: [:operand :distance | | previous | + previous := distances at: operand ifAbsent: Number infinity. + distances at: operand put: (previous min: distance + length)]. + succ phisDo: [:phi | | operand previous | + operand := phi atOperand: block. + previous := distances at: operand ifAbsent: Number infinity. + distances at: operand put: (previous min: length)]]. + distancesExit + at: block + ifPresent: [:last | (self areEqual: last and: distances) ifTrue: [^false]]. + distancesExit at: block put: distances copy. + index := block indexOf: block lastInstruction. + block lastInstruction realReverseDo: [:instruction | + self computeUseDistanceOf: instruction number: index using: distances. + index := index - 1]. + distancesEntry at: block put: distances. + ^true +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +couple: block withPredecessor: predecessor + | predecessors wentry oldSentry predWexit predSexit newSentry difference | + predecessors := block predecessors intersection: blocksDone. + predecessors removeIfPresent: block. + wentry := allocationEntry at: block. + oldSentry := (predecessors gather: [:pred | spillExit at: pred]) + intersection: wentry. + predWexit := allocationExit at: predecessor. + predSexit := spillExit at: predecessor. + newSentry := (oldSentry , predSexit) withoutDuplicates intersection: wentry. + (wentry rejectAll: predWexit) do: [:value | + (block phis includes: value) + ifFalse: [self scheduleReload: value before: predecessor lastInstruction]]. + (newSentry rejectAll: predSexit) do: [:value | self scheduleSpillFor: value]. + difference := newSentry rejectAll: oldSentry. + predecessors do: [:pred | | sexit | + sexit := spillExit at: pred. + (difference rejectAll: sexit) do: [:value | self scheduleSpillFor: value]] +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +coupleWithPredecessors: block + | predecessors | + predecessors := block predecessors intersection: blocksDone. + currentlySpilled := (predecessors gather: [:pred | spillExit at: pred]) + intersection: currentlyAvailable. + predecessors do: [:pred | | wexit sexit | + wexit := allocationExit at: pred. + (currentlyAvailable rejectAll: wexit) do: [:value | + (block phis includes: value) + ifFalse: [self scheduleReload: value before: pred lastInstruction]]. + sexit := spillExit at: pred. + (currentlySpilled rejectAll: sexit) + do: [:value | self scheduleSpillFor: value]] +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +deferCouplingOf: block + deferredCouplings add: block +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +doAllocation + | redefinitions | + self computeLoops; computeLiveness; computeUseDistances. + firstBlock withSuccessorsPostOrder reverseDo: [:block | + currentBlock := block. + self + computeEntryRegistersOf: block; + coupleWithPredecessors: block; + spillAsBeladyIn: block. + blocksDone add: block. + block successors + do: [:succ | (blocksDone includes: succ) + ifTrue: [self couple: succ withPredecessor: block]]]. + redefinitions := self computeTemporaryIndexes; insertSpillsAndReloads. + self reconstructSSA: redefinitions +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock + ^firstBlock +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock: aBlock + firstBlock := aBlock +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + currentlyAvailable := OrderedCollection new. + currentlySpilled := OrderedCollection new. + amountOfRegisters := 5. + scheduledReloads := OrderedCollection new. + scheduledSpills := OrderedCollection new. + blocksDone := Set new. + allocationEntry := Dictionary new. + allocationExit := Dictionary new. + distancesExit := IdentityDictionary new. + spillExit := Dictionary new. + temporaries := Dictionary new. + deferredCouplings := Set new +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initLoopHeader: block + | loop available candidates liveThrough pressure freeLoop extra | + loop := loops at: block. + available := (block phis , (self liveInOf: block)) withoutDuplicates. + candidates := self subsetOf: available usedIn: loop. + liveThrough := available rejectAll: candidates. + candidates size < self amountOfRegisters + ifTrue: [ + pressure := self maxPressureIn: loop. + freeLoop := self amountOfRegisters - pressure + liveThrough size. + self sortByUseDistance: liveThrough in: block firstInstruction. + extra := liveThrough copyTo: freeLoop] + ifFalse: [ + self sortByUseDistance: candidates in: block firstInstruction. + candidates := candidates copyTo: self amountOfRegisters. + extra := OrderedCollection new]. + currentlyAvailable := (candidates , extra) withoutDuplicates. + allocationEntry at: block put: currentlyAvailable copy +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initUsual: block + | frequencies take max chosen candidates | + frequencies := Dictionary new. + take := OrderedCollection new. + candidates := OrderedCollection new. + max := block predecessors size. + block predecessors do: [:pred | | wend | + wend := allocationExit at: pred. + wend do: [:value | | previous var | + var := (block isPhiArgument: value) + ifTrue: [ + (self is: value liveAt: block firstNonPhi) ifTrue: [ + previous := frequencies at: value ifAbsent: [0]. + frequencies at: value put: previous + 1. + candidates addIfAbsent: value. + (frequencies at: value) = max ifTrue: [ + candidates removeIfPresent: value. + take addIfAbsent: value]]. + block phiWithArgument: value] + ifFalse: [value]. + previous := frequencies at: var ifAbsent: [0]. + frequencies at: var put: previous + 1. + candidates addIfAbsent: var. + (frequencies at: var) = max ifTrue: [ + candidates removeIfPresent: var. + take addIfAbsent: var]]]. + candidates := self selectAliveIn: candidates at: block firstInstruction. + self sortByUseDistance: candidates in: block firstInstruction. + take := self selectAliveIn: take at: block firstInstruction. + chosen := candidates truncateTo: self amountOfRegisters - take size. + take addAll: chosen. + currentlyAvailable := take withoutDuplicates. + allocationEntry at: block put: currentlyAvailable copy +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertReloadOf: value before: user + | stack index reload | + stack := self activationRecord. + index := self temporaryIndexOf: value. + reload := OBinaryConstantOperation + left: stack + right: index + name: #_basicAt:. + stack addUse: reload at: #left. + user + beforeInsert: reload; + replaceUsesOf: value with: reload. + ^reload +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertSpillOf: value + | stack index store | + stack := self activationRecord. + index := self temporaryIndexOf: value. + store := OTernaryOperation + receiver: stack + left: index + right: value + name: #_basicAt:put:. + stack addUse: store at: #receiver. + value addUse: store at: #right. + value lastPhi afterInsert: store. + liveness kill: store at: store +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertSpillsAndReloads + | redefinitions | + scheduledSpills do: [:value | self insertSpillOf: value]. + redefinitions := Dictionary new. + scheduledReloads do: [:association | | value user reload collection | + value := association key. + user := association value. + reload := self insertReloadOf: value before: user. + collection := redefinitions at: value ifAbsentPut: [OrderedCollection new]. + collection add: reload]. + ^redefinitions +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +is: value liveAt: instruction + ^(self useDistanceFrom: instruction to: value) !!= Number infinity +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +isLoopHead: block + ^loops includesKey: block +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +limitAt: inst to: limit + | stack | + self sortByUseDistance: currentlyAvailable in: inst. + stack := self activationRecord. + (currentlyAvailable includes: stack) + ifTrue: [currentlyAvailable remove: stack; addFirst: stack]. + currentlyAvailable from: limit + 1 to: currentlyAvailable size do: [:value | + ((currentlySpilled includes: value) not + and: [(self useDistanceFrom: inst to: value) !!= Number infinity]) + ifTrue: [self scheduleSpillFor: value]. + currentlySpilled removeIfPresent: value]. + currentlyAvailable := currentlyAvailable truncateTo: limit +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +liveInOf: block + ^liveness liveInOf: block +! ! + +!OptimizingBraunAllocator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +liveness + ^liveness +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +maxPressureIn: loop + ^liveness maxPressureIn: loop +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +reconstructSSA: reloads + | reconstructor | + reconstructor := OptimizingSSAReconstructor new firstBlock: firstBlock. + reloads + keysAndValuesDo: [:variable :redefinitions | reconstructor + setupFor: variable with: redefinitions; + reconstructSSA] +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +scheduleReload: value before: user + self haltWhen: value printString = '[send #classField to {#_basicAt:}]'. + scheduledReloads add: value -> user +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +scheduleSpillFor: value + scheduledSpills addIfAbsent: value +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +selectAliveIn: collection at: instruction + ^collection select: [:value | self is: value liveAt: instruction] +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +sortByUseDistance: candidates in: inst + | stack | + candidates + sortBy: [:a :b | (self useDistanceFrom: inst to: a) + < (self useDistanceFrom: inst to: b)]. + stack := self activationRecord. + (candidates includes: stack) + ifTrue: [candidates remove: stack; addFirst: stack] +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +spillAsBeladyIn: block + | k | + k := self amountOfRegisters. + block realInstructionsDo: [:inst | | missing | + missing := (inst operands rejectAll: currentlyAvailable) + select: [:arg | self clobbersOneRegister: arg]. + missing do: [:use | + currentlyAvailable addIfAbsent: use. + currentlySpilled addIfAbsent: use]. + self limitAt: inst to: k. + inst isMessageSend ifTrue: [self limitAt: inst to: 1]. + (self clobbersOneRegister: inst) ifTrue: [ + self limitAt: inst next to: k - 1. + currentlyAvailable add: inst]. + missing do: [:value | self scheduleReload: value before: inst]]. + allocationExit at: block put: currentlyAvailable copy. + spillExit at: block put: currentlySpilled copy +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +subsetOf: available usedIn: loop + " + todo + " + ^available +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +temporaryIndexOf: value + ^-1 - (temporaries at: value) +! ! + +!OptimizingBraunAllocator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +useDistanceFrom: inst to: anotherInst + | near distances | + near := inst useDistanceTo: anotherInst. + ^near = Number infinity + ifTrue: [ + distances := distancesExit at: currentBlock. + distances at: anotherInst ifAbsent: [Number infinity]] + ifFalse: [near] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingBraunAllocator class' category: #OCompiler! +OptimizingBraunAllocator class + instanceVariableNames: ''! + +!OptimizingBraunAllocator class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OptimizingBraunAllocator initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingBraunAssigner.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingBraunAssigner.Class.st new file mode 100644 index 00000000..ad0576f1 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingBraunAssigner.Class.st @@ -0,0 +1,344 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingBraunAssigner category: #OCompiler! +Object subclass: #OptimizingBraunAssigner + instanceVariableNames: 'firstBlock liveness allocationEntry temporaries preferences occupied assignments clusters processed' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingBraunAssigner commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +allRegistersByPreference + ^self wordSize = 4 + ifTrue: [ + Array + with: ebp + with: eax + with: edx + with: ecx + with: esi] + ifFalse: [ + OrderedCollection new + add: rbp; + add: rax; + add: rdx; + add: rcx; + add: rsi; + add: r8; + add: r9; + add: r10; + add: r11; + add: rbx; + add: r12; + add: r13; + add: r14; + add: r15; + yourself] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assignRegisters + self + computeLiveness; + computeClusters; + purgeAllocationEntry; + preinitializePreferences; + integrateABIPreferences; + doAssignRegisters. + ^assignments +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assignRegisterTo: instruction + | register | + self enforceConstraints: instruction. + instruction operandsDo: [:operand | + (self clobbersOneRegister: operand) ifTrue: [ + (self does: operand dieAt: instruction) ifTrue: [ + register := assignments at: operand. + occupied removeKey: register]]]. + (self clobbersOneRegister: instruction) ifTrue: [ + self getRegisterFor: instruction. + (self does: instruction dieAt: instruction) ifTrue: [ + register := assignments at: instruction. + occupied removeKey: register]] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +clobbersOneRegister: inst + ^((inst isJump or: [inst isUnaryOperation and: [inst name == #push]]) + or: [inst isTernaryOperation and: [inst name = #_basicAt:put:]]) not +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +colorBlock: block + " + Determine initial register occupation and color φ-nodes + " + | incoming initial | + incoming := liveness liveInOf: block. + initial := incoming collect: [:value | (assignments at: value) -> value]. + occupied := Dictionary withAll: initial. + block phisDo: [:phi | self getRegisterFor: phi]. + block predecessors do: [:pred | + (processed includes: pred) + ifTrue: [self insertParallelCopiesFrom: pred to: block]]. + "Assign registers" + block firstNonPhi do: [:instruction | self assignRegisterTo: instruction]. + processed add: block. + block successors do: [:succ | + (processed includes: succ) + ifTrue: [self insertParallelCopiesFrom: block to: block successors first]] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeClusters + firstBlock withSuccessorsPostOrder do: [:block | + block phisDo: [:phi | | cluster | + cluster := clusters at: phi ifAbsentPut: [OrderedCollection with: phi]. + phi operandsDo: [:value | + cluster addIfAbsent: value. + clusters at: value put: cluster]]] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeLiveness + liveness analyzeLiveness +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +computePreferences: block + | argument | + argument := firstBlock firstInstruction next next. + argument do: [:instr | | reg index pref | + instr isLoadImplicit ifFalse: [^self]. + reg := instr source. + index := self indexOf: reg. + pref := preferences at: instr. + pref at: index put: (pref at: index) + 1] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +doAssignRegisters + self preallocateImplicitVariables. + firstBlock withSuccessorsPostOrder + reverseDo: [:block | self colorBlock: block] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +does: operand dieAt: instruction + ^liveness does: operand dieAt: instruction +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +enforceConstraints: instruction + +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +from: allocator + firstBlock := allocator firstBlock. + allocationEntry := allocator allocationEntry +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +getRegisterFor: var + | prefs candidates cluster reg | + assignments at: var ifPresent: [:preset | reg := preset]. + reg == nil ifTrue: [ + var isMessageSend ifTrue: [reg := self getRegisterForSend: var] ifFalse: [ + prefs := preferences at: var. + candidates := self registersByPreference: prefs. + cluster := clusters at: var ifAbsent: nil. + cluster ifNotNil: [ + assignments + at: cluster + ifPresent: [:best | candidates remove: best; addFirst: best]]. + reg := candidates + detect: [:register | (occupied includesKey: register) not]]]. + occupied at: reg put: var. + assignments at: var put: reg. + cluster ifNotNil: [assignments at: cluster put: reg]. + ^reg +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +getRegisterForSend: send + | receiver copy | + receiver := send receiver. + copy := receiver insertCopyBefore: send. + copy addUse: send at: #receiver. + receiver removeUse: send at: #receiver. + liveness kill: copy at: send. + assignments at: copy put: eax. + ^eax +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +indexOf: register + | regs | + regs := self wordSize = 4 + ifTrue: #(ebp eax edx ecx esi) + ifFalse: [#(rbp rax rdx rcx rsi r8 r9 r10 r11 rbx r12 r13 r14 r15)]. + ^regs indexOf: register name +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + processed := OrderedCollection new. + preferences := Dictionary new. + assignments := Dictionary new. + clusters := Dictionary new +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertCopyTo: dest for: phi at: pred + | value copy | + value := phi atOperand: pred. + copy := value insertCopyBefore: pred lastInstruction. + assignments at: copy put: dest. + value removeUse: phi at: pred. + phi atOperand: pred put: copy +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertParallelCopiesFrom: pred to: block + | phis sources destinations saved | + phis := block phis. + sources := phis collect: [:phi | | value | + value := phi atOperand: pred. + assignments at: value]. + destinations := phis collect: [:phi | assignments at: phi]. + "remove nops" + phis size to: 1 by: -1 do: [:i | + (sources at: i) = (destinations at: i) ifTrue: [ + sources removeIndex: i. + destinations removeIndex: i. + phis removeIndex: i]]. + "schedule copies" + saved := OrderedCollection new. + [ + self scheduleCopyingOf: phis from: pred. + phis size > 0] + whileTrue: [| free | + free := phis first. + self insertPushOf: (free atOperand: pred) at: pred. + saved add: free. + phis removeIndex: 1. + sources removeIndex: 1. + destinations removeIndex: 1]. + [saved isEmpty] whileFalse: [| var | + var := saved removeLast. + self insertPopOf: var at: pred] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPopOf: var at: pred + | pop reg | + pop := OUnaryOperation receiver: nil name: #pop. + pred lastInstruction beforeInsert: pop. + reg := assignments at: var. + assignments at: pop put: reg +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPushOf: var at: pred + var insertPushBefore: pred lastInstruction +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +integrateABIPreferences + firstBlock withSuccessorsPostOrder + do: [:block | self computePreferences: block] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +liveInOf: block + ^liveness liveInOf: block +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +liveness: aLivenessAnalysis + liveness := aLivenessAnalysis +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +preallocateImplicitVariables + | in | + in := OrderedCollection new. + firstBlock instructionsDo: [:inst | | register | + inst isLoadImplicit ifTrue: [ + register := inst source. + register ifNotNil: [ + in add: inst. + assignments at: inst put: register]]]. + (liveness liveInOf: firstBlock) addAll: in +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +preinitializePreferences + firstBlock instructionsWithSuccessorsDo: [:instruction | | array | + array := #[0 0 0 0 0 0 0 0]. + preferences at: instruction put: array copy] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +purgeAllocationEntry + firstBlock withSuccessorsPostOrder do: [:block | | alive available | + alive := self liveInOf: block. + available := allocationEntry at: block. + available + removeAllSuchThat: [:var | (block phis includes: var) + or: [(alive includes: var) not]]] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +registersByPreference: prefs + | all indexes | + all := self allRegistersByPreference. + indexes := (1 to: all size) asOrderedCollection. + indexes sortBy: [:i :j | (prefs at: i) > (prefs at: j) or: [i < j]]. + ^indexes collect: [:index | all at: index] +! ! + +!OptimizingBraunAssigner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +scheduleCopyingOf: phis from: pred + | destinations changed sources | + sources := phis collect: [:phi | | value | + value := phi atOperand: pred. + assignments at: value]. + destinations := phis collect: [:phi | assignments at: phi]. + "schedule copies" + changed := true. + [phis size > 0 and: changed] whileTrue: [ + changed := false. + phis size to: 1 by: -1 do: [:i | | dest phi | + dest := destinations at: i. + (sources includes: dest) ifFalse: [ + phi := phis at: i. + self insertCopyTo: dest for: phi at: pred. + sources removeIndex: i. + destinations removeIndex: i. + phis removeIndex: i. + changed := true]]] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingBraunAssigner class' category: #OCompiler! +OptimizingBraunAssigner class + instanceVariableNames: ''! + +!OptimizingBraunAssigner class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OptimizingBraunAssigner initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingCFGSimplifier.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingCFGSimplifier.Class.st new file mode 100644 index 00000000..42e3d15c --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingCFGSimplifier.Class.st @@ -0,0 +1,133 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingCFGSimplifier category: #OCompiler! +Object subclass: #OptimizingCFGSimplifier + instanceVariableNames: 'firstBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingCFGSimplifier commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingCFGSimplifier methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +addPredecessor: predecessor like: middle to: final + final phisDo: [:phi | | source | + source := phi atOperand: middle. + phi addVariable: source from: predecessor]. + final addPredecessor: predecessor. + ^final +! ! + +!OptimizingCFGSimplifier methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +cleanFrom: aBlock + | all | + firstBlock := aBlock. + all := firstBlock successorsPostOrder. + [ + firstBlock updatePredecessors. + self simplify] + whileTrue: [all do: [:block | block dissolveIfUnreachable]] +! ! + +!OptimizingCFGSimplifier methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +hoistBranchIn: succ to: pred + | jump branch condition new target1 target2 | + jump := pred lastInstruction. + branch := succ lastInstruction. + condition := branch variable. + succ + phisDo: [:phi | + condition := phi atOperand: pred. + phi removeBlock: pred]; + removePredecessor: pred. + target1 := self addPredecessor: pred like: succ to: branch target. + target2 := self addPredecessor: pred like: succ to: branch implicitTarget. + new := branch class + variable: condition + target: target1 + implicitTarget: target2. + condition addUse: new at: #variable. + jump dissolveReplacingWith: new +! ! + +!OptimizingCFGSimplifier methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +simplify + | changed | + changed := false. + firstBlock postOrderDo: [:block | + changed := (self tryFoldingRedundantBranch: block) or: changed. + (self tryRemovingEmptyBlock: block) ifTrue: [changed := true] ifFalse: [ + changed := (self tryCombining: block) or: changed. + changed := (self tryHoistingBranch: block) or: changed]]. + ^changed +! ! + +!OptimizingCFGSimplifier methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +tryCombining: block + | last following | + last := block lastInstruction. + (last isUnconditionalJump and: [ + following := last target. + following predecessors size = 1]) + ifTrue: [ + following successors do: [:successor | + successor + addPredecessor: block; + removePredecessor: following; + phisDo: [:phi | phi replaceBlock: following with: block]]. + last afterInsertAll: following firstInstruction; dissolve. + ^true]. + ^false +! ! + +!OptimizingCFGSimplifier methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +tryFoldingRedundantBranch: block + | last | + last := block lastInstruction. + (last isConditionalJump and: [last target == last implicitTarget]) + ifTrue: [| jump | + jump := OJump to: last target. + last dissolveReplacingWith: jump. + ^true]. + (last isConditionalJump and: [last variable isConstant]) ifTrue: [ + last replaceWithUnconditional: last variable value in: block. + ^true]. + ^false +! ! + +!OptimizingCFGSimplifier methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +tryHoistingBranch: block + | last following | + last := block lastInstruction. + (last isUnconditionalJump and: [ + following := last target. + following isEmptyBranch or: [following isEmptyPhiBranch]]) + ifTrue: [ + self hoistBranchIn: following to: block. + ^true]. + ^false +! ! + +!OptimizingCFGSimplifier methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +tryRemovingEmptyBlock: block + | following | + block isEmptyJump ifTrue: [ + following := block lastInstruction target. + following incorporatePhisFrom: block; removePredecessor: block. + block predecessors do: [:predecessor | + predecessor lastInstruction retargetFrom: block to: following. + following addPredecessor: predecessor]. + ^true]. + ^false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingCFGSimplifier class' category: #OCompiler! +OptimizingCFGSimplifier class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingCSSATransformer.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingCSSATransformer.Class.st new file mode 100644 index 00000000..afd9338c --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingCSSATransformer.Class.st @@ -0,0 +1,54 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingCSSATransformer category: #OCompiler! +Object subclass: #OptimizingCSSATransformer + instanceVariableNames: 'firstBlock liveness' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingCSSATransformer commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingCSSATransformer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +applyTransformation + self splitPhis; coalescePhis +! ! + +!OptimizingCSSATransformer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +coalescePhis + " + to do + " + +! ! + +!OptimizingCSSATransformer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock: block + firstBlock := block +! ! + +!OptimizingCSSATransformer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +liftPhisIn: block + block phisDo: [:phi | + phi variablesWithBlocksDo: [:var :pred | | copy | + copy := var insertCopyBefore: pred lastInstruction. + phi atOperand: pred put: copy. + var removeUse: phi at: pred; dissolveIfUnused. + copy addUse: phi at: pred]] +! ! + +!OptimizingCSSATransformer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +splitPhis + firstBlock withSuccessorsPostOrder do: [:block | self liftPhisIn: block] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingCSSATransformer class' category: #OCompiler! +OptimizingCSSATransformer class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingCodeEmitter.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingCodeEmitter.Class.st new file mode 100644 index 00000000..0fa57b76 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingCodeEmitter.Class.st @@ -0,0 +1,908 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingCodeEmitter category: #OCompiler! +Object subclass: #OptimizingCodeEmitter + instanceVariableNames: 'allocation assembler abi jumpDestinations assemblers method firstBlock currentBlockIndex blocks messageLinker' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingCodeEmitter commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingCodeEmitter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +abi: anAbi + abi := anAbi. + assembler wordSize: anAbi wordSize +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +activationRecord + ^firstBlock firstInstruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocation: anAllocation + allocation := anAllocation +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleAsNative: asNativeSend + | src dst | + src := allocation at: asNativeSend receiver. + dst := allocation at: asNativeSend. + self ASSERT: src == dst. + assembler convertToNativeInteger: src +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleAsObject: asNativeSend + | src dst | + src := allocation at: asNativeSend receiver. + dst := allocation at: asNativeSend. + self ASSERT: src == dst. + assembler clearIntegerBit: src +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleAsPointer: asNativeSend + | src dst oop | + src := allocation at: asNativeSend receiver. + dst := allocation at: asNativeSend. + self ASSERT: src == dst. + oop := assembler newLabel. + assembler + testIntegerBit: src; + jumpIfZeroTo: oop; + convertToNativeInteger: src; + @ oop; + setIntegerBit: src +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleAsSmallInteger: asNativeSend + | src dst | + src := allocation at: asNativeSend receiver. + dst := allocation at: asNativeSend. + self ASSERT: src == dst. + assembler convertToSmallInteger: src +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicAt: instruction + | base index result | + base := allocation at: instruction left. + index := allocation at: instruction right. + result := allocation at: instruction. + assembler + convertToNativeInteger: index; + load: result from: base atIndexAt: index. + result !!= index ifTrue: [assembler convertToSmallInteger: index] +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicAtConstant: instruction + | src dst index | + src := allocation at: instruction left. + dst := allocation at: instruction ifAbsent: [^self]. + index := instruction right. + assembler load: dst from: src atIndex: index +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicAtPut: instruction + | base value index | + index := instruction left value. + index isInteger ifTrue: [^self assembleBasicAtPutConstant: instruction]. + base := allocation at: instruction receiver. + value := allocation at: instruction right. + index := allocation at: index. + assembler + convertToNativeInteger: index; + store: value in: base indexAt: index; + convertToSmallInteger: index +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicAtPutConstant: instruction + | base value position | + base := allocation at: instruction receiver. + value := allocation at: instruction right. + position := instruction left value. + assembler store: value in: base index: position +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicFlags: basicFlagsSend + | base dst | + base := allocation at: basicFlagsSend receiver. + dst := allocation at: basicFlagsSend. + assembler + loadZeroExtendByte: dst from: base atOffset: _Flags; + convertToSmallInteger: dst +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicFlagsPut: basicFlagsPut + self assembleByteAtOffset: _Flags put: basicFlagsPut +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicSize: basicSizeSend + | base dst | + base := allocation at: basicSizeSend receiver. + dst := allocation at: basicSizeSend. + assembler + loadZeroExtendByte: dst from: base atOffset: _SmallSize; + convertToSmallInteger: dst +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicSizePut: basicSizePut + self assembleByteAtOffset: _SmallSize put: basicSizePut +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicSizePutConstant: basicFlagsPutSend + | base value | + base := allocation at: basicFlagsPutSend left. + value := basicFlagsPutSend right. + assembler storeByte: value in: base offset: _SmallSize +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicULongAt: instruction + | base index result | + base := allocation at: instruction left. + index := allocation at: instruction right. + result := allocation at: instruction. + assembler + convertToNativeInteger: index; + load: result e from: base atIndexAt: index. + result !!= index ifTrue: [assembler convertToSmallInteger: index] +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicULongAtConstant: instruction + | src dst index | + src := allocation at: instruction left. + dst := allocation at: instruction ifAbsent: [^self]. + index := instruction right. + assembler load: dst e from: src atIndex: index +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicULongAtPut: instruction + | base value index | + index := instruction left value. + index isInteger + ifTrue: [^self assembleBasicULongAtPutConstant: instruction]. + base := allocation at: instruction receiver. + value := allocation at: instruction right. + index := allocation at: index. + assembler + convertToNativeInteger: index; + store: value e in: base indexAt: index; + convertToSmallInteger: index +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBasicULongAtPutConstant: instruction + | base value position | + base := allocation at: instruction receiver. + value := allocation at: instruction right. + position := instruction left value. + assembler store: value e in: base index: position +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBitAnd: instruction + | left right | + left := allocation at: instruction left. + right := allocation at: instruction right. + assembler and: left with: right +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBitAndConstant: instruction + | left value | + left := allocation at: instruction. + value := instruction right * 2 + 1. + assembler and: left with: value +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBitOr: instruction + | left right | + left := allocation at: instruction left. + right := allocation at: instruction right. + assembler or: left with: right +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBitOrConstant: instruction + | left value | + left := allocation at: instruction. + value := instruction right * 2 + 1. + assembler or: left with: value +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBitShift: instruction + | src offset | + src := allocation at: instruction left. + instruction right isConstant + ifTrue: [self assembleBitShift: src by: instruction right value] + ifFalse: [ + offset := allocation at: instruction right. + offset halt] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBitShift: src by: amount + amount > 0 + ifTrue: [ + assembler + convertToNativeInteger: src; + shiftLeft: src by: amount + 1; + convertToSmallInteger: src] + ifFalse: [ + assembler + shiftRight: src by: 0 - amount; + setIntegerBit: src] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleBitShiftConstant: instruction + | src amount | + src := allocation at: instruction left. + amount := instruction right. + self assembleBitShift: src by: amount +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleByteAt: instruction + | base index dst | + base := allocation at: instruction left. + index := allocation at: instruction right. + dst := allocation at: instruction. + assembler + convertToNativeInteger: index; + loadZeroExtendByte: dst from: base atIndexAt: index; + convertToSmallInteger: dst. + index !!= dst ifTrue: [assembler convertToSmallInteger: index] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleByteAt: index put: instruction + self assembleByteAtOffset: index - 1 put: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleByteAtConstant: instruction + | base index dst | + base := allocation at: instruction left. + index := instruction right. + dst := allocation at: instruction. + assembler + loadZeroExtendByte: dst from: base atIndex: index; + convertToSmallInteger: dst +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleByteAtOffset: offset put: instruction + | base value | + base := allocation at: instruction left. + value := allocation at: instruction right. + assembler + convertToNativeInteger: value; + renameByteRegisterIfNeeded: value + preserving: base + during: [:final | assembler storeByte: final byte in: base offset: offset]; + convertToSmallInteger: value +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleByteAtPut: instruction + | index base value | + base := allocation at: instruction receiver. + index := allocation at: instruction left. + value := allocation at: instruction right. + assembler + convertToNativeInteger: index; + convertToNativeInteger: value; + renameByteRegisterIfNeeded: value + preserving: base + preserving: index + during: [:final | assembler store: final byte in: base indexAt: index]; + convertToSmallInteger: value; + convertToSmallInteger: index +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleCompare: instruction + | left right | + left := allocation at: instruction left. + right := allocation at: instruction right. + assembler compare: left with: right +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleCompareConstant: instruction jumpTrue: trueBlock jumpFalse: falseBlock + | left value | + left := allocation at: instruction left. + instruction right isSmallInteger + ifTrue: [ + value := instruction right * 2 + 1. + assembler compare: left with: value] + ifFalse: [ + value := instruction right. + assembler compare: left withPointer: value]. + self assembleJumpTrue: trueBlock orJumpFalse: falseBlock in: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleCopy: instruction + | source target | + target := allocation at: instruction. + source := allocation at: instruction receiver. + self assembleCopyIfNeeded: source to: target +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleCopyIfNeeded: source to: dest + source = dest ifTrue: [^self]. + assembler move: source to: dest +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleCopyResult: instruction + | dest | + dest := allocation at: instruction ifAbsent: [^self]. + self assembleCopyIfNeeded: abi regR to: dest +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleEquals: instruction + self + assembleCompare: instruction; + assembleJumpTrue: [:label | assembler jumpIfEqualTo: label] + orJumpFalse: [:label | assembler jumpIfNotEqualTo: label] + in: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleEqualsConstant: instruction + self + assembleCompareConstant: instruction + jumpTrue: [:label | assembler jumpIfEqualTo: label] + jumpFalse: [:label | assembler jumpIfNotEqualTo: label] +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleExtendedSize: extendedSizeSend + | base dst | + base := allocation at: extendedSizeSend receiver. + dst := allocation at: extendedSizeSend. + assembler + load: dst e from: base atIndex: _ExtendedSize; + convertToSmallInteger: dst +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleFrom: aBasicBlock + firstBlock := aBasicBlock. + blocks := firstBlock withSuccessorsPostOrder reversed. + self doAssemble +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleGenericMessageSend: instruction + self assembleLookup: instruction selector +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleGreater: instruction + self + assembleCompare: instruction; + assembleJumpTrue: [:label | assembler jumpIfGreaterSignedTo: label] + orJumpFalse: [:label | assembler jumpIfLessOrEqualSignedTo: label] + in: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleGreaterConstant: instruction + self + assembleCompareConstant: instruction + jumpTrue: [:label | assembler jumpIfGreaterSignedTo: label] + jumpFalse: [:label | assembler jumpIfLessOrEqualSignedTo: label] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleGreaterEqual: instruction + self + assembleCompare: instruction; + assembleJumpTrue: [:label | assembler jumpIfGreaterOrEqualSignedTo: label] + orJumpFalse: [:label | assembler jumpIfLessSignedTo: label] + in: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleGreaterEqualConstant: instruction + self + assembleCompareConstant: instruction + jumpTrue: [:label | assembler jumpIfGreaterOrEqualSignedTo: label] + jumpFalse: [:label | assembler jumpIfLessSignedTo: label] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleIsSmallInteger: instruction + | src | + src := allocation at: instruction receiver. + assembler testIntegerBit: src. + self + assembleJumpTrue: [:label | assembler jumpIfNotZeroTo: label] + orJumpFalse: [:label | assembler jumpIfZeroTo: label] + in: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleJumpIfEqualTo: target + | label | + label := jumpDestinations at: target. + assembler jumpIfEqualTo: label +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleJumpTo: target + | label index | + label := jumpDestinations at: target. + index := blocks indexOf: target. + ^((index - currentBlockIndex) abs > 18 or: true) + ifTrue: [assembler jumpTo: label] + ifFalse: [assembler shortJumpTo: label] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleJumpTrue: blockJumpTrue orJumpFalse: blockJumpFalse in: instruction + | next end result label loadFalse | + next := instruction next. + (next isConditionalJump and: [instruction allUses size = 1]) + ifTrue: [ + label := jumpDestinations at: next target. + next isJumpTrue + ifTrue: [blockJumpTrue value: label] + ifFalse: [blockJumpFalse value: label]. + self nextBlock !!= next implicitTarget + ifTrue: [self assembleJumpTo: next implicitTarget]] + ifFalse: [ + result := allocation at: instruction. + loadFalse := assembler newLabel. + end := assembler newLabel. + blockJumpFalse value: loadFalse. + self assembleLoadConstant: true to: result. + assembler shortJumpTo: end; @ loadFalse. + self assembleLoadConstant: false to: result. + assembler @ end] +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleLoadConstant: value to: register + | constant | + value isSmallInteger + ifTrue: [ + constant := value * 2 + 1. + assembler load: register withImmediate: constant] + ifFalse: [assembler load: register withPointer: value] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleLookup: selector + self haltWhen: selector = #'&'. + messageLinker emitSend: selector using: assembler +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleLower: instruction + self + assembleCompare: instruction; + assembleJumpTrue: [:label | assembler jumpIfLessSignedTo: label] + orJumpFalse: [:label | assembler jumpIfGreaterOrEqualSignedTo: label] + in: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleLowerConstant: instruction + self + assembleCompareConstant: instruction + jumpTrue: [:label | assembler jumpIfLessSignedTo: label] + jumpFalse: [:label | assembler jumpIfGreaterOrEqualSignedTo: label] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleLowerEqual: instruction + self + assembleCompare: instruction; + assembleJumpTrue: [:label | assembler jumpIfLessOrEqualSignedTo: label] + orJumpFalse: [:label | assembler jumpIfGreaterSignedTo: label] + in: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleLowerEqualConstant: instruction + self + assembleCompareConstant: instruction + jumpTrue: [:label | assembler jumpIfLessOrEqualSignedTo: label] + jumpFalse: [:label | assembler jumpIfGreaterSignedTo: label] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleMinus: instruction + | left right | + left := allocation at: instruction left. + right := allocation at: instruction right. + assembler + add: 1 to: left; + subtract: right from: left +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleMinusConstant: instruction + | left value | + left := allocation at: instruction left. + value := instruction right * 2. + assembler subtract: value from: left +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleNegate: instruction + | src dst | + src := allocation at: instruction receiver. + dst := allocation at: instruction. + self ASSERT: dst = src. + assembler + negate: src; + add: 2 to: dst +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleNotEqualConstant: instruction + self + assembleCompareConstant: instruction + jumpTrue: [:label | assembler jumpIfNotEqualTo: label] + jumpFalse: [:label | assembler jumpIfEqualTo: label] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleObjectAtOffsetPut: instruction + | base value offset | + base := allocation at: instruction receiver. + value := allocation at: instruction right. + offset := instruction left value. + assembler storePointer: value in: base offset: offset +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assemblePlus: instruction + | left right | + left := allocation at: instruction left. + right := allocation at: instruction right. + assembler + clearIntegerBit: left; + add: right to: left +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assemblePlusConstant: instruction + | left value | + left := allocation at: instruction left. + value := instruction right * 2. + assembler add: value to: left +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assemblePop: instruction + | register | + register := allocation at: instruction. + assembler pop: register +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assemblePush: instruction + | register | + register := allocation at: instruction receiver. + assembler push: register +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleRestorePreviousContext: instruction + assembler restoreCallerFrame +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleTimesConstant: instruction + | left value shift | + left := allocation at: instruction left. + value := instruction right. + self ASSERT: (value == 4 or: [value == 8]). + shift := value == 4 ifTrue: [2] ifFalse: [3]. + assembler + clearIntegerBit: left; + shiftLeft: left by: shift; + setIntegerBit: left +! ! + +!OptimizingCodeEmitter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleTransferControlTo: instruction + | code receiver | + receiver := allocation at: instruction left. + code := allocation at: instruction right. + receiver == assembler regA ifTrue: [ + code == assembler regT + ifTrue: [ + assembler move: assembler regA to: assembler regR. + receiver := assembler regR] + ifFalse: [ + assembler move: assembler regA to: assembler regT. + receiver := assembler regT]]. + self assembleCopyIfNeeded: code to: assembler regA. + self assembleCopyIfNeeded: receiver to: assembler regR. + self activationRecord savesPreviousSelf + ifTrue: [assembler pop: assembler regS]. + assembler restoreCallerFrame; jumpToReg: assembler regA +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +currentBlock + ^blocks at: currentBlockIndex +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +doAssemble + self labelBlocks. + blocks withIndexDo: [:block :index | | label | + currentBlockIndex := index. + label := jumpDestinations at: block. + assembler @ label. + block firstInstruction acceptVisitor: self]. + assembler applyFixups +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + jumpDestinations := Dictionary new. + self initializeLowLevelAssembler; initializeAssemblers +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeAssemblers + assemblers := Dictionary new + at: #'+' put: #Plus; + at: #'-' put: #Minus; + at: #'*' put: #Times; + at: #'=' put: #Equals; + at: #'==' put: #Equals; + at: #'~=' put: #NotEqual; + at: #'!!=' put: #NotEqual; + at: #'<' put: #Lower; + at: #'<=' put: #LowerEqual; + at: #'>=' put: #GreaterEqual; + at: #'>' put: #Greater; + at: #'&' put: #BitAnd; + at: #bitAnd: put: #BitAnd; + at: #bitOr: put: #BitOr; + at: #bitShift: put: #BitShift; + at: #_asNative put: #AsNative; + at: #_asObject put: #AsObject; + at: #_asPointer put: #AsPointer; + at: #_asSmallInteger put: #AsSmallInteger; + at: #_byteAt: put: #ByteAt; + at: #_basicAt: put: #BasicAt; + at: #_basicULongAt: put: #BasicULongAt; + at: #_byteAt:put: put: #ByteAtPut; + at: #_basicAt:put: put: #BasicAtPut; + at: #_basicULongAt:put: put: #BasicULongAtPut; + at: #_objectAtOffset:put: put: #ObjectAtOffsetPut; + at: #_basicFlags put: #BasicFlags; + at: #_basicFlags: put: #BasicFlagsPut; + at: #_smallSize put: #BasicSize; + at: #_smallSize: put: #BasicSizePut; + at: #_largeSize put: #ExtendedSize; + at: #_largeSize: put: #ExtendedSizePut; + at: #_isSmallInteger put: #IsSmallInteger; + at: #_transferControlTo: put: #TransferControlTo; + at: #negate put: #Negate; + at: #push put: #Push; + at: #pop put: #Pop; + at: #copy put: #Copy; + at: #copyResult put: #CopyResult; + yourself +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeLowLevelAssembler + assembler := JITAssembler64 on: #[] writeStream +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +jumpWasAssembledInComparison: aConditionalJump + | prev | + prev := aConditionalJump prev. + prev == aConditionalJump variable ifFalse: [^false]. + prev allUses size !!= 1 ifTrue: [^false]. + prev class == OMessageSend ifTrue: [^false]. + prev class == OPhi ifTrue: [^false]. + (prev isKindOf: OBinaryOperation) ifTrue: [ + (#(< <= = == !!= >= >) includes: prev name) ifTrue: [^true]. + (#(_basicAt:) includes: prev name) ifTrue: [^false]]. + prev class == OUnaryOperation ifTrue: [ + (#(_isSmallInteger) includes: prev name) ifTrue: [^true]. + (#(copy) includes: prev name) ifTrue: [^false]]. + self halt +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +labelBlocks + blocks do: [:block | | label | + label := assembler newLabel. + jumpDestinations at: block put: label] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +messageLinker: aMessageLinker + messageLinker := aMessageLinker +! ! + +!OptimizingCodeEmitter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +method: aCompiledMethod + method := aCompiledMethod +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +nativeCode + ^assembler nativeCode +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextBlock + ^blocks at: currentBlockIndex + 1 ifAbsent: [nil] +! ! + +!OptimizingCodeEmitter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +savesPreviousSelf + ^self activationRecord savesPreviousSelf +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +selectorFor: instruction + ^assemblers at: instruction name +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithConstant: instruction + | selector | + selector := #assemble , (self selectorFor: instruction) , #Constant:. + self perform: selector asSymbol with: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithVariable: instruction + | selector | + selector := #assemble , (self selectorFor: instruction) , #':'. + self perform: selector asSymbol with: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBranch: branch comparing: aBoolean + | reg | + (self jumpWasAssembledInComparison: branch) ifTrue: [^self]. + reg := allocation at: branch variable. + assembler compare: reg withPointer: aBoolean. + self assembleJumpIfEqualTo: branch target. + branch implicitTarget !!= self nextBlock + ifTrue: [self assembleJumpTo: branch implicitTarget] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJump: aJump + aJump target == self nextBlock ifTrue: [^self]. + self assembleJumpTo: aJump target +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpFalse: aJumpFalse + self visitBranch: aJumpFalse comparing: false +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpTrue: aJumpTrue + self visitBranch: aJumpTrue comparing: true +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadConstant: aLoadConstant + | register value | + register := allocation + at: aLoadConstant + ifAbsent: [aLoadConstant isUsed ifTrue: [self halt] ifFalse: [^self]]. + value := aLoadConstant value. + self assembleLoadConstant: value to: register +! ! + +!OptimizingCodeEmitter methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadImplicit: instruction + | frame | + instruction name == #activationRecord ifTrue: [^assembler buildFrame]. + instruction name == #self ifTrue: [ + frame := instruction prev. + ^frame hasFrame ifTrue: [ + assembler + reserveStackSlots: frame temporaries + 2; + store: assembler regR in: assembler regFP index: 0; + loadVwithPointer: method; + store: assembler regV in: assembler regFP index: -1. + self savesPreviousSelf ifTrue: [assembler push: assembler regS]]] +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitMessageSend: aMessageSend + self assembleGenericMessageSend: aMessageSend. + firstBlock activationRecord haveFrame +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitNullary: instruction + | selector | + selector := #assemble , (self selectorFor: instruction) , #':'. + self perform: selector asSymbol with: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitPhi: phiInstruction + +! ! + +!OptimizingCodeEmitter methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitReturn: aReturnInstruction + | source | + source := allocation at: aReturnInstruction source. + self assembleCopyIfNeeded: source to: assembler regR. + self savesPreviousSelf + ifTrue: [assembler pop: assembler regS; restoreCallerFrame] + ifFalse: [ + assembler + restoreCallerFrame; + load: assembler regS from: assembler regFP atIndex: 0]. + assembler return +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitTernary: instruction + | selector | + selector := #assemble , (self selectorFor: instruction) , #':'. + self perform: selector asSymbol with: instruction +! ! + +!OptimizingCodeEmitter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitUnary: instruction + | selector | + selector := #assemble , (self selectorFor: instruction) , #':'. + self perform: selector asSymbol with: instruction +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingCodeEmitter class' category: #OCompiler! +OptimizingCodeEmitter class + instanceVariableNames: ''! + +!OptimizingCodeEmitter class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OptimizingCodeEmitter initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingInstructionFragmenter.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingInstructionFragmenter.Class.st new file mode 100644 index 00000000..75087590 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingInstructionFragmenter.Class.st @@ -0,0 +1,447 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingInstructionFragmenter category: #OCompiler! +Object subclass: #OptimizingInstructionFragmenter + instanceVariableNames: 'method messages firstBlock abi' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingInstructionFragmenter commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +abi: anAbi + abi := anAbi +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +activationRecord + ^firstBlock firstInstruction +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock: aBasicBlock + firstBlock := aBasicBlock +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentActivationRecordDeclarationIn: aBasicBlock + | declaration implicit | + declaration := aBasicBlock firstInstruction. + implicit := OActivationContext named: #activationRecord. + implicit source: abi regFP. + declaration dissolveReplacingWith: implicit +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentArgumentsIn: aBasicBlock with: aCompiledMethod + method := aCompiledMethod. + self + fragmentActivationRecordDeclarationIn: aBasicBlock; + fragmentSelfDeclarationIn: aBasicBlock; + fragmentSpecialABIArgumentsIn: aBasicBlock; + fragmentNormalArgumentsIn: aBasicBlock +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentBinaryCommutative: instruction + | left right | + left := instruction receiver. + right := instruction arguments first. + right isConstant + ifTrue: [^self replace: instruction withBinary: left withConstant: right]. + left isConstant + ifTrue: [^self replace: instruction withBinary: right withConstant: left]. + self replace: instruction withVariable: left with: right +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentBinaryCompare: instruction + | left right new | + left := instruction receiver. + right := instruction arguments first. + right isConstant + ifTrue: [^self replace: instruction withBinary: left withConstant: right]. + left isConstant ifTrue: [ + new := self replace: instruction withBinary: right withConstant: left. + ^new invertOperation]. + self replace: instruction withVariable: left with: right +! ! + +!OptimizingInstructionFragmenter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentBinaryNonCommutative: instruction + | left right | + left := instruction receiver. + right := instruction arguments first. + right isConstant + ifTrue: [^self replace: instruction withBinary: left withConstant: right]. + self replace: instruction withVariable: left with: right +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentCallSite: instruction + | callsite | + callsite := OBinaryConstantOperation + left: self activationRecord + right: 2 + name: #_basicAt:. + self activationRecord addUse: callsite at: #left. + instruction dissolveReplacingWith: callsite +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentGenericMessage: instruction + | arguments new | + arguments := instruction arguments. + new := arguments + collect: [:argument | self insertPush: argument before: instruction]. + instruction arguments: new. + arguments + do: [:argument | argument removeUse: instruction; dissolveIfUnused]. + firstBlock activationRecord haveFrame +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentInstructionsFrom: aBasicBlock + self firstBlock: aBasicBlock. + aBasicBlock + reversePostOrderDo: [:block | self fragmentInstructionsOf: block] +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentInstructionsOf: block + block firstInstruction acceptVisitor: self +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentNormalArgumentsIn: aBasicBlock + | count argument position context | + count := 0. + context := aBasicBlock firstInstruction. + argument := context next next. + [argument isDefineArgument] whileTrue: [ + argument := argument next. + count := count + 1]. + argument := argument prev. + position := 0. + [position < count] whileTrue: [| new next | + argument isUsed + ifTrue: [ + new := OBinaryConstantOperation + left: context + right: position + 3 + name: #_basicAt:. + context addUse: new at: #left. + argument dissolveReplacingWith: new. + argument := new prev] + ifFalse: [ + next := argument prev. + argument dissolve. + argument := next]. + position := position + 1] +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentNot: instruction + | negated | + negated := instruction receiver halt shallowCopy. + negated negateOperation. + negated left addUse: negated at: #left. + negated right addUse: negated at: #right. + instruction dissolveReplacingWith: negated. + instruction receiver dissolveIfUnused +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentPatchIndirectCallSiteTo: instruction + | nativeCode callsite patch | + nativeCode := instruction arguments first. + callsite := OBinaryConstantOperation + left: self activationRecord + right: 2 + name: #_basicAt:. + patch := OTernaryOperation + receiver: callsite + left: 0 + right: nativeCode + name: #_basicAt:put:. + self activationRecord addUse: callsite at: #left. + callsite addUse: patch at: #receiver. + nativeCode addUse: patch at: #right. + instruction dissolveReplacingWith: patch. + patch beforeInsert: callsite +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentSelfDeclarationIn: aBasicBlock + | declaration implicit | + declaration := aBasicBlock firstInstruction next. + implicit := OLoadImplicit named: #self. + declaration dissolveReplacingWith: implicit +! ! + +!OptimizingInstructionFragmenter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentSpecialABIArgumentsIn: aBasicBlock + | literals i actual next load | + literals := method literals. + literals size = 0 ifTrue: [^self]. + (literals at: 1) == #savePreviousSelf ifTrue: [ + aBasicBlock activationRecord doSavePreviousSelf. + load := aBasicBlock firstInstruction detect: [:inst | inst isConstant]. + load dissolve. + literals := literals copyFrom: 2]. + literals size = 0 ifTrue: [^self]. + (literals at: 1) == #specialABIBegin ifFalse: [^self]. + i := 2. + [(literals at: i) == #specialABIEnd] + whileFalse: [| name register implicit argument receiver regname | + name := literals at: i. + regname := literals at: i + 1. + register := self registerNamed: regname. + name = #self + ifTrue: [ + receiver := aBasicBlock firstInstruction + detect: [:instruction | instruction isLoadImplicit + and: [instruction name = #self]]. + receiver source: register] + ifFalse: [ + implicit := (OLoadImplicit named: name) source: register. + argument := aBasicBlock firstInstruction + detect: [:instruction | instruction isDefineArgument + and: [instruction name = name]]. + argument dissolveReplacingWith: implicit]. + i := i + 2]. + actual := aBasicBlock firstInstruction detect: [:inst | inst isConstant]. + [ + next := actual next. + actual dissolve. + actual isConstant and: [actual value == #specialABIEnd]] + whileFalse: [actual := next] +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentTernary: instruction + | receiver left right new | + receiver := instruction receiver. + left := instruction arguments first. + right := instruction arguments second. + new := OTernaryOperation + receiver: receiver + left: left + right: right + name: instruction selector. + receiver addUse: new at: #receiver. + left addUse: new at: #left. + right addUse: new at: #right. + self + ASSERT: (#(_basicAt:put: _basicULongAt:put: _byteAt:put: _objectAtOffset:put:) + includes: new name). + instruction replaceAllUsesWith: right; dissolveReplacingWith: new +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentTransferControlTo: instruction + | receiver machine | + receiver := instruction receiver. + machine := instruction arguments first. + self replace: instruction withVariable: receiver with: machine +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentUnary: instruction + | receiver new | + receiver := instruction receiver. + " receiver isConstant ifTrue: [self halt]." + new := OUnaryOperation new receiver: receiver; name: instruction selector. + receiver addUse: new at: #receiver. + instruction dissolveReplacingWith: new +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + self initializeMessages +! ! + +!OptimizingInstructionFragmenter methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeMessages + messages := Dictionary new + at: #'+' put: #BinaryCommutative:; + at: #'-' put: #BinaryNonCommutative:; + at: #'*' put: #BinaryCommutative:; + at: #'<' put: #BinaryCompare:; + at: #'<=' put: #BinaryCompare:; + at: #'=' put: #BinaryCompare:; + at: #'==' put: #BinaryCompare:; + at: #'~=' put: #BinaryCompare:; + at: #'!!=' put: #BinaryCompare:; + at: #'>=' put: #BinaryCompare:; + at: #'>' put: #BinaryCompare:; + at: #'&' put: #BinaryCommutative:; + at: #_asNative put: #Unary:; + at: #_asObject put: #Unary:; + at: #_asPointer put: #Unary:; + at: #_asSmallInteger put: #Unary:; + at: #bitAnd: put: #BinaryCommutative:; + at: #bitOr: put: #BinaryCommutative:; + at: #bitShift: put: #BinaryNonCommutative:; + at: #_byteAt: put: #BinaryNonCommutative:; + at: #_basicAt: put: #BinaryNonCommutative:; + at: #_basicULongAt: put: #BinaryNonCommutative:; + at: #_byteAt:put: put: #Ternary:; + at: #_basicAt:put: put: #Ternary:; + at: #_basicULongAt:put: put: #Ternary:; + at: #_objectAtOffset:put: put: #Ternary:; + at: #_basicFlags put: #Unary:; + at: #_basicFlags: put: #BinaryNonCommutative:; + at: #_smallSize put: #Unary:; + at: #_smallSize: put: #BinaryNonCommutative:; + at: #_largeSize put: #Unary:; + at: #_largeSize: put: #BinaryNonCommutative:; + at: #_isSmallInteger put: #Unary:; + at: #_transferControlTo: put: #TransferControlTo:; + at: #_callSite put: #CallSite:; + at: #_patchIndirectCallSiteTo: put: #PatchIndirectCallSiteTo:; + at: #not put: #Not:; + yourself +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertCopyResultAfter: anInstruction + | copy | + copy := OUnaryOperation receiver: anInstruction name: #copyResult. + anInstruction + afterInsert: copy; + replaceAllUsesWith: copy; + addUse: copy at: #receiver +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPush: anInstruction before: instruction + | push | + push := OUnaryOperation receiver: anInstruction name: #push. + anInstruction addUse: push at: #receiver. + instruction beforeInsert: push. + ^push +! ! + +!OptimizingInstructionFragmenter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +registerNamed: regname + ^abi perform: regname +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replace: instruction withBinary: left withConstant: right + | constant new | + constant := right value. + new := OBinaryConstantOperation + left: left + right: constant + name: instruction selector. + left addUse: new at: #left. + instruction dissolveReplacingWith: new. + right dissolveIfUnused. + ^new +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +replace: instruction withVariable: left with: right + | new | + new := OBinaryVariableOperation + left: left + right: right + name: instruction selector. + left addUse: new at: #left. + right addUse: new at: #right. + instruction dissolveReplacingWith: new. + ^new +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +selectorFor: name + ^(#fragment , (messages at: name ifAbsent: [#GenericMessage:])) asSymbol +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithConstant: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithVariable: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitDefineArgument: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJump: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpFalse: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpTrue: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadConstant: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadImplicit: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitMessageSend: instruction + | selector | + selector := self selectorFor: instruction selector. + self perform: selector with: instruction +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitPhi: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitReturn: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitTernary: instruction + +! ! + +!OptimizingInstructionFragmenter methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitUnary: instruction + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingInstructionFragmenter class' category: #OCompiler! +OptimizingInstructionFragmenter class + instanceVariableNames: ''! + +!OptimizingInstructionFragmenter class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OptimizingInstructionFragmenter initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingInstructionSelector.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingInstructionSelector.Class.st new file mode 100644 index 00000000..bba7d7a0 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingInstructionSelector.Class.st @@ -0,0 +1,436 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingInstructionSelector category: #OCompiler! +Object subclass: #OptimizingInstructionSelector + instanceVariableNames: 'firstBlock tiles roots messages' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingInstructionSelector commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +doSelection + self numberArguments. + firstBlock reversePostOrderDo: [:block | self generateTilingFor: block]. + self removeUnused +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock: aBasicBlock + firstBlock := aBasicBlock +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +generateTilingFor: block + block firstInstruction acceptVisitor: self +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + tiles := IdentityDictionary new. + self initializeMessages +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeMessages + messages := Dictionary new + at: #'+' put: #CommutativeBinary:; + at: #'-' put: #Minus:; + at: #'*' put: #CommutativeBinary:; + at: #'<' put: #Compare:; + at: #'<=' put: #Compare:; + at: #'=' put: #Compare:; + at: #'==' put: #Compare:; + at: #'~=' put: #Compare:; + at: #'!!=' put: #Compare:; + at: #'>=' put: #Compare:; + at: #'>' put: #Compare:; + at: #'&' put: #CommutativeBinary:; + at: #bitAnd: put: #CommutativeBinary:; + at: #_byteAt: put: #Binary:; + at: #_basicAt: put: #Binary:; + at: #_byteAt:put: put: #Ternary:; + at: #_basicAt:put: put: #Ternary:; + at: #_basicFlags put: #Unary:; + at: #_smallSize put: #Unary:; + at: #_largeSize put: #Unary:; + at: #_isSmallInteger put: #Unary:; + at: #_transferControlTo: put: #Binary:; + at: #not put: #Not:; + yourself +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertCopyResultAfter: anInstruction + | copy | + copy := OUnaryOperation receiver: anInstruction name: #copyResult. + anInstruction + afterInsert: copy; + replaceAllUsesWith: copy; + addUse: copy at: #receiver +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPush: anInstruction before: instruction + | push tile | + push := OUnaryOperation receiver: anInstruction name: #push. + anInstruction addUse: push at: #receiver. + instruction beforeInsert: push. + tile := self newTile: push. + self tile: push as: tile beUsed. + ^push +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +newTile: instruction + ^OTiling for: instruction +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +numberArguments + | count instruction i | + count := 0. + instruction := firstBlock firstInstruction next. + [instruction next isLoadImplicit] whileTrue: [ + instruction := instruction next. + count := count + 1]. + i := 0. + [i < count] whileTrue: [ + instruction name: i + 3. + instruction := instruction prev. + i := i + 1] +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeUnused + firstBlock instructionsWithSuccessorsDo: [:instruction | | tile | + tile := self tileOf: instruction. + (tile instruction == instruction and: [tile isUsed]) + ifFalse: [instruction replaceAllUsesWith: tile instruction; dissolve]] +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +selectorFor: name + ^(#send , (messages at: name ifAbsent: [#GenericMessage:])) asSymbol +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +send: instruction left: left commutativeRight: right + right isConstant + ifTrue: [^self tile: instruction using: left toConstant: right value]. + left isConstant + ifTrue: [^self tile: instruction using: right toConstant: left value]. + self tile: instruction using: left to: right +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +send: instruction left: left comparedTo: right + right isConstant + ifTrue: [^self tile: instruction using: left toConstant: right value]. + left isConstant + ifTrue: [^(self tile: instruction using: right toConstant: left value) invertOperation]. + self tile: instruction using: left to: right +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +send: instruction left: left minusRight: right + right isConstant + ifTrue: [^self tile: instruction using: left toConstant: right value]. + left isConstant + ifTrue: [^(self doesntWork + tile: instruction + using: right + toConstant: 0 - left value) + invert]. + self tile: instruction using: left to: right +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +send: instruction left: left right: right + right isConstant + ifTrue: [^self tile: instruction using: left toConstant: right value]. + left isConstant + ifTrue: [^self tile: instruction using: right toConstant: left value]. + self tile: instruction using: left to: right +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +send: instruction receiver: receiver + receiver isConstant ifTrue: [^self tile: instruction toConstant: receiver]. + self tile: instruction receiver: receiver +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +send: instruction receiver: receiver left: left right: right + " + right isConstant + ifTrue: [^self tile: instruction using: left toConstant: right value]. + left isConstant + ifTrue: [^self tile: instruction using: right toConstant: left value]. + " + self + tile: instruction + using: receiver + left: left + right: right +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +sendBinary: instruction + self + send: instruction + left: instruction receiver + right: instruction arguments first +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +sendCommutativeBinary: instruction + self + send: instruction + left: instruction receiver + commutativeRight: instruction arguments first +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +sendCompare: instruction + self + send: instruction + left: instruction receiver + comparedTo: instruction arguments first +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +sendGenericMessage: instruction + | arguments values tile new | + arguments := instruction arguments. + values := Array with: instruction receiver withAll: arguments. + new := arguments + collect: [:argument | self insertPush: argument before: instruction]. + instruction arguments: new. + arguments do: [:argument | argument removeUse: instruction]. + values do: [:value | (self tileOf: value) beUsed]. + tile := self newTile: instruction. + self + tile: instruction as: tile beUsed; + insertCopyResultAfter: instruction +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +sendMinus: instruction + self + send: instruction + left: instruction receiver + minusRight: instruction arguments first +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +sendNot: instruction + | negated tile | + negated := (self tileOf: instruction receiver) beUsed. + negated instruction negateOperation. + tile := self newTile: instruction. + self tile: instruction as: tile. + ^instruction +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +sendTernary: instruction + self + send: instruction + receiver: instruction receiver + left: instruction arguments first + right: instruction arguments second +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +sendUnary: instruction + self send: instruction receiver: instruction receiver +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +tile: instruction as: tile + tiles at: instruction put: tile +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +tile: instruction receiver: receiver + | receivertile new tile | + receivertile := (self tileOf: receiver) beUsed. + new := OUnaryOperation new receiver: receiver; name: instruction selector. + receiver addUse: new at: #receiver. + instruction beforeInsert: new. + tile := self newTile: new. + self + tile: new as: tile; + tile: instruction as: tile. + ^new +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +tile: instruction using: receiver left: left right: right + | lefttile righttile receivertile tile new | + receivertile := (self tileOf: receiver) beUsed. + lefttile := (self tileOf: left) beUsed. + righttile := (self tileOf: right) beUsed. + new := OTernaryOperation + receiver: receiver + left: left + right: right + name: instruction selector. + receiver addUse: new at: #receiver. + left addUse: new at: #left. + right addUse: new at: #right. + instruction beforeInsert: new. + tile := self newTile: new. + self + tile: new as: tile beUsed; + tile: instruction as: righttile "for at:put:". + ^new +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +tile: instruction using: left to: right + | lefttile righttile tile new | + lefttile := (self tileOf: left) beUsed. + righttile := (self tileOf: right) beUsed. + new := OBinaryVariableOperation + left: left + right: right + name: instruction selector. + left addUse: new at: #left. + right addUse: new at: #right. + instruction beforeInsert: new. + tile := self newTile: new. + self + tile: new as: tile; + tile: instruction as: tile. + ^new +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +tile: instruction using: left toConstant: value + | lefttile new tile | + lefttile := (self tileOf: left) beUsed. + new := OBinaryConstantOperation + left: left + right: value + name: instruction selector. + left addUse: new at: #left. + instruction beforeInsert: new. + tile := self newTile: new. + self + tile: new as: tile; + tile: instruction as: tile. + ^new +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +tileOf: instruction + ^tiles at: instruction +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJump: instruction + | new | + new := self newTile: instruction. + self tile: instruction as: new beUsed +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpFalse: instruction + | tile new | + tile := self tileOf: instruction variable. + tile beUsed. + new := self newTile: instruction. + self tile: instruction as: new beUsed +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpTrue: instruction + | tile new | + tile := self tileOf: instruction variable. + tile beUsed. + new := self newTile: instruction. + self tile: instruction as: new beUsed +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadConstant: instruction + | tile | + tile := self newTile: instruction. + self tile: instruction as: tile +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadImplicit: instruction + | tile sourcetile new | + instruction name isSmallInteger + ifTrue: [ + sourcetile := (self tileOf: instruction source) beUsed. + new := OBinaryConstantOperation + left: instruction source + right: instruction name + name: #_basicAt:. + instruction source addUse: new at: #left. + instruction beforeInsert: new; replaceAllUsesWith: new; dissolve. + tile := self newTile: new. + self tile: new as: tile] + ifFalse: [ + tile := self newTile: instruction. + self tile: instruction as: tile. + instruction name == #activationRecord ifTrue: [tile beUsed]] +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitMessageSend: instruction + | selector | + selector := self selectorFor: instruction selector. + self perform: selector with: instruction +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitPhi: instruction + | tile | + instruction variables + collect: [:source | self tileOf: source] + thenDo: #beUsed. + tile := self newTile: instruction. + self tile: instruction as: tile +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitReturn: instruction + | tile new | + tile := self tileOf: instruction source. + tile beUsed. + new := self newTile: instruction. + self tile: instruction as: new beUsed +! ! + +!OptimizingInstructionSelector methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitUnary: instruction + | tile new | + tile := self tileOf: instruction receiver. + tile beUsed. + new := self newTile: instruction. + self tile: instruction as: new beUsed +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingInstructionSelector class' category: #OCompiler! +OptimizingInstructionSelector class + instanceVariableNames: ''! + +!OptimizingInstructionSelector class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OptimizingInstructionSelector initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingLivenessAnalysis.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingLivenessAnalysis.Class.st new file mode 100644 index 00000000..fb898fdd --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingLivenessAnalysis.Class.st @@ -0,0 +1,143 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingLivenessAnalysis category: #OCompiler! +Object subclass: #OptimizingLivenessAnalysis + instanceVariableNames: 'firstBlock liveIn liveOut loops pressures expirations' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingLivenessAnalysis commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingLivenessAnalysis methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +analyzeLiveness + | changed all | + liveIn := Dictionary new. + pressures := Dictionary new. + expirations := Dictionary new. + changed := true. + all := firstBlock withSuccessorsPostOrder. + [changed] whileTrue: [ + changed := false. + all do: [:block | changed := (self analyzeLivenessOf: block) or: changed]]. + all do: [:block | self computeExpirationsAt: block] +! ! + +!OptimizingLivenessAnalysis methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +analyzeLivenessOf: block + | alive last changed pressure | + self haltWhen: block hash = 46528. + alive := self gatherAliveAfter: block. + self + haltWhen: (alive + anySatisfy: [:value | value printString + beginsWith: '[53422] [jump to #45650]']). + pressure := pressures at: block ifAbsentPut: [0]. + last := block lastInstruction. + last realReverseDo: [:instr | | presure | + instr operandsDo: [:value | + self haltWhen: (value printString beginsWith: '[53422] [jump to #45650]'). + alive addIfAbsent: value]. + alive removeIfPresent: instr. + pressure := presure max: alive size]. + block phis reverseDo: [:phi | alive removeIfPresent: phi]. + pressures at: block put: pressure. + changed := true. + liveIn + at: block ifPresent: [:prev | changed := prev size !!= alive size]; + at: block put: alive. + ^changed +! ! + +!OptimizingLivenessAnalysis methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeExpirationsAt: block + | alive last | + alive := self gatherAliveAfter: block. + last := block lastInstruction. + last isConditionalJump ifTrue: [ + block successors do: [:succ | | real leftover | + real := liveIn at: succ. + leftover := alive rejectAll: real. + leftover do: [:val | self kill: val at: succ firstInstruction]]]. + last realReverseDo: [:instr | self computeExpirationsAt: instr with: alive] +! ! + +!OptimizingLivenessAnalysis methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeExpirationsAt: instruction with: alive + instruction operandsDo: [:value | + (alive includes: value) ifFalse: [self kill: value at: instruction]. + alive addIfAbsent: value]. + (alive includes: instruction) + ifTrue: [alive remove: instruction] + ifFalse: [self kill: instruction at: instruction] +! ! + +!OptimizingLivenessAnalysis methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +does: operand dieAt: instruction + | dying | + dying := expirations at: instruction ifAbsent: [^false]. + ^dying includes: operand +! ! + +!OptimizingLivenessAnalysis methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock: aBlock + firstBlock := aBlock +! ! + +!OptimizingLivenessAnalysis methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +gatherAliveAfter: block + | incoming extra | + incoming := block successors + gather: [:succ | liveIn at: succ ifAbsent: [OrderedCollection new]]. + extra := block successors gather: [:succ | succ phiValuesComingFrom: block]. + ^(incoming , extra) withoutDuplicates +! ! + +!OptimizingLivenessAnalysis methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + +! ! + +!OptimizingLivenessAnalysis methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +kill: value at: instruction + | collection | + collection := expirations + at: instruction + ifAbsentPut: [OrderedCollection new]. + collection addIfAbsent: value +! ! + +!OptimizingLivenessAnalysis methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +liveInOf: block + ^liveIn at: block +! ! + +!OptimizingLivenessAnalysis methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +loops: aDictionary + loops := aDictionary +! ! + +!OptimizingLivenessAnalysis methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +maxPressureIn: loopBlocks + | all | + all := loopBlocks collect: [:block | pressures at: block]. + ^all max +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingLivenessAnalysis class' category: #OCompiler! +OptimizingLivenessAnalysis class + instanceVariableNames: ''! + +!OptimizingLivenessAnalysis class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OptimizingLivenessAnalysis initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingMethodInliner.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingMethodInliner.Class.st new file mode 100644 index 00000000..7fc7b531 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingMethodInliner.Class.st @@ -0,0 +1,99 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingMethodInliner category: #OCompiler! +Object subclass: #OptimizingMethodInliner + instanceVariableNames: 'firstBlock methods abi' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingMethodInliner commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingMethodInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +abi: anAbi + abi := anAbi +! ! + +!OptimizingMethodInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +bindVariablesOf: initialBlock with: aMessageSend + | values | + values := OrderedCollection + with: aMessageSend receiver + withAll: aMessageSend arguments. + initialBlock instructionsDo: [:instruction | + instruction isDefineArgument ifFalse: [^self]. + instruction name == #activationRecord ifFalse: [ + instruction replaceAllUsesWith: values first. + values removeFirst]. + instruction dissolve] +! ! + +!OptimizingMethodInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock: aBasicBlock + firstBlock := aBasicBlock +! ! + +!OptimizingMethodInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineAllMessages + firstBlock withSuccessorsPostOrder do: [:block | | current | + current := block. + block instructionsAsCollection do: [:instruction | + (self shouldInline: instruction) + ifTrue: [current := self inlineMethod: instruction in: current]]] +! ! + +!OptimizingMethodInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlinedMethodFor: aMessageSend + ^methods detect: [:m | m selector == aMessageSend selector] +! ! + +!OptimizingMethodInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineMessages + self inlineMessagesIn: firstBlock +! ! + +!OptimizingMethodInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineMethod: aMessageSend in: block + | method nativizer initialBlock | + method := self inlinedMethodFor: aMessageSend. + nativizer := OptimizingNativizer on: method. + initialBlock := nativizer + abi: abi; + inlinedMethods: methods; + decompose; + firstBlock. + self bindVariablesOf: initialBlock with: aMessageSend. + ^block inline: initialBlock replacing: aMessageSend +! ! + +!OptimizingMethodInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +methods: methodsToInline + methods := methodsToInline +! ! + +!OptimizingMethodInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +selectors + ^methods collect: #selector +! ! + +!OptimizingMethodInliner methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +shouldInline: instruction + ^instruction isMessageSend + and: [self selectors includes: instruction selector] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingMethodInliner class' category: #OCompiler! +OptimizingMethodInliner class + instanceVariableNames: ''! + +!OptimizingMethodInliner class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: basicBlock + ^self basicNew firstBlock: basicBlock +! ! + + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingNativizer.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingNativizer.Class.st new file mode 100644 index 00000000..f50f5609 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingNativizer.Class.st @@ -0,0 +1,258 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingNativizer category: #OCompiler! +Object subclass: #OptimizingNativizer + instanceVariableNames: 'method firstBlock messageLinker inlinedMethods abi' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingNativizer commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +abi: anAbi + abi := anAbi +! ! + +!OptimizingNativizer methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocate + | allocator | + allocator := OptimizingRegisterAllocator new + abi: abi; + firstBlock: firstBlock. + ^allocator doAllocation +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assembleUsing: allocation + | assembler | + assembler := OptimizingCodeEmitter new + method: method; + abi: abi; + allocation: allocation; + messageLinker: messageLinker. + assembler assembleFrom: firstBlock. + ^assembler nativeCode +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +bindVariables + | binder | + binder := OptimizingVariableBinder new abi: abi. + binder doBindingFrom: firstBlock +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decompose + self + inlineBlocks; + verifyPredecessors; + inlineMethods; + verifyPredecessors; + unifyReturns; + verifyPredecessors; + bindVariables +! ! + +!OptimizingNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +defaultInlinedMethods + ^BeeNativizationEnvironment primitiveObjectMethods , ((OrderedCollection new + add: Object >> #byteAtValid:; + add: Object >> #byteAtValid:put:; + add: ProtoObject >> #objectAtValid:; + add: ProtoObject >> #objectAtValid:put:; + add: Object >> #basicObjectIndexOf:; + add: Object >> #primitiveAt:put:; + add: ProtoObject >> #behavior; + add: ProtoObject >> #class; + add: Species >> #instSize; + add: Species >> #_instancesAreArrayed; + add: Species >> #_instancesHavePointers; + add: Species >> #memory; + add: Species >> #instanceBehavior; + add: Species >> #primitiveNew; + add: Species >> #primitiveNew:; + add: ProtoObject >> #primitiveAt:; + add: ProtoObject >> #_cachedLookup:; + add: ProtoObject >> #_cachedLookup:in:; + add: CompiledMethod >> #prepareForExecution; + add: CompiledMethod >> #isNativized; + add: CompiledMethod >> #nativeCode; + add: CompiledMethod >> #blockCount; + add: CompiledMethod >> #literalIndexFrom:; + add: CompiledBlock >> #argumentCount; + add: CompiledBlock >> #blockNumber; + add: CompiledBlock >> #blockCode; + add: CompiledBlock >> #method; + add: NativeCode >> #code; + add: NativeCode >> #isFresh; + add: CharacterArray >> #characterAtValid:; + add: GCSpace >> #commitedLimit; + add: GCSpace >> #nextFree; + add: GCSpace >> #nextFree:; + yourself) + collect: [:cm | cm dmrVersion ifNil: [cm]]) +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +eliminateDeadPhis + OptimizingPhiSimplification new processFrom: firstBlock +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +enforceTwoAddressCodeUsing: allocation + | enforcer | + enforcer := OptimizingTwoAddressEnforcer new + allocation: allocation; + firstBlock: firstBlock. + ^enforcer doEnforce +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock + ^firstBlock +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +fragmentInstructions + | binder | + binder := OptimizingInstructionFragmenter new abi: abi. + binder + fragmentArgumentsIn: firstBlock with: method; + fragmentInstructionsFrom: firstBlock +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + inlinedMethods := self defaultInlinedMethods +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineBlocks + OptimizingBlockInliner new on: firstBlock; doInline +! ! + +!OptimizingNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlinedMethods + ^inlinedMethods +! ! + +!OptimizingNativizer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlinedMethods: aCollection + inlinedMethods := aCollection +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlineMethods + (OptimizingMethodInliner on: firstBlock) + abi: abi; + methods: self inlinedMethods; + inlineAllMessages +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +irFor: aCompiledMethod + | visitor ir cm | + visitor := OptimizingVisitor new. + cm := (SendSite isUndermethod: aCompiledMethod selector) + ifTrue: [ProtoObject >> aCompiledMethod selector] + ifFalse: [aCompiledMethod]. + ir := visitor visit: cm parseTree. + ^ir +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +messageLinker: aMessageLinker + messageLinker := aMessageLinker +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +method: aCompiledMethod + method := aCompiledMethod. + firstBlock := self irFor: aCompiledMethod +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +nativeCode + ^self nativize +! ! + +!OptimizingNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026 13:27:39'! +nativize + | allocation | + allocation := self + decompose; + fragmentInstructions; + simplifyCFG; + removeRedundantCode; + simplifyCFG; + splitCriticalEdges; + transformToCSSA; + allocate. + ^self + enforceTwoAddressCodeUsing: allocation; + simplifyCFG; + assembleUsing: allocation +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeRedundantCode + OptimizingValueNumbering new workFrom: firstBlock +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +selectInstructions + | allocator | + allocator := OptimizingInstructionSelector new firstBlock: firstBlock. + ^allocator doSelection +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +simplifyCFG + OptimizingCFGSimplifier new cleanFrom: firstBlock +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +splitCriticalEdges + firstBlock splitAllCriticalEdges +! ! + +!OptimizingNativizer methodsFor: 'allocation' stamp: 'KenD 28/Jun/2026 13:27:39'! +transformToCSSA + | transformer | + transformer := OptimizingCSSATransformer new firstBlock: firstBlock. + transformer applyTransformation +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +unifyReturns + firstBlock unifyReturns +! ! + +!OptimizingNativizer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +verifyPredecessors + firstBlock verifyAllPredecessorsSanity +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingNativizer class' category: #OCompiler! +OptimizingNativizer class + instanceVariableNames: ''! + +!OptimizingNativizer class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + +!OptimizingNativizer class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aCompiledMethod + ^self new method: aCompiledMethod +! ! + + +OptimizingNativizer initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingPhiSimplification.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingPhiSimplification.Class.st new file mode 100644 index 00000000..9c7aaeff --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingPhiSimplification.Class.st @@ -0,0 +1,62 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingPhiSimplification category: #OCompiler! +Object subclass: #OptimizingPhiSimplification + instanceVariableNames: 'marks' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingPhiSimplification commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingPhiSimplification methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + marks := Set new +! ! + +!OptimizingPhiSimplification methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMarked: instruction + ^marks includes: instruction +! ! + +!OptimizingPhiSimplification methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +mark: instruction + ^marks add: instruction +! ! + +!OptimizingPhiSimplification methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +process: aBasicBlock + | instruction | + instruction := aBasicBlock firstInstruction. + [instruction isPhi] whileTrue: [| vars next | + next := instruction next. + vars := instruction variables. + vars size to: 1 by: -1 do: [:i | | var | + var := vars at: i. + (self isMarked: var) ifFalse: [instruction removeVariable: var]]. + instruction := next] +! ! + +!OptimizingPhiSimplification methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +processFrom: firstBlock + firstBlock instructionsWithSuccessorsDo: [:inst | self mark: inst]. + firstBlock reversePostOrderDo: [:block | self process: block] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingPhiSimplification class' category: #OCompiler! +OptimizingPhiSimplification class + instanceVariableNames: ''! + +!OptimizingPhiSimplification class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OptimizingPhiSimplification initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingRegisterAllocator.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingRegisterAllocator.Class.st new file mode 100644 index 00000000..922cb09c --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingRegisterAllocator.Class.st @@ -0,0 +1,559 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingRegisterAllocator category: #OCompiler! +Object subclass: #OptimizingRegisterAllocator + instanceVariableNames: 'abi liveRanges unifiedLiveRanges expirations allocation free used usedOut locals currentBlock firstBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingRegisterAllocator commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +abi: anAbi + abi := anAbi. + free := OrderedCollection new. + free + add: abi regS; + add: abi regT; + add: abi regA; + add: abi regR; + add: abi regFP +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +activationRecord + ^firstBlock firstInstruction +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +addLiveRangesOf: block + block + instructionsDo: [:instruction | self + assureLiveRangeStartingAt: instruction + in: block] +! ! + +!OptimizingRegisterAllocator methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocateFor: inst + | range register starts ends | + (self rangesEndingAt: inst) reverseDo: [:ending | self free: ending]. + range := self unifiedLiveRangeOf: inst. + starts := range startsAt: inst. + ends := range endsAt: inst. + (ends not and: [range isSpilled not]) ifTrue: [ + starts ifTrue: [self assignRegisterTo: inst in: range]. + register := allocation at: range. + allocation at: inst put: register]. + inst isMessageSend ifTrue: [self repairToRespectABI: inst with: range] +! ! + +!OptimizingRegisterAllocator methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocateLiveRanges + self preallocateImplicitVariables. + firstBlock reversePostOrderDo: [:block | + currentBlock := block. + self recalculateRegisterUsage. + block instructionsDo: [:inst | self allocateFor: inst]. + usedOut at: block put: used copy] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocation + ^allocation +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assign: register to: aRange + ((free includes: register) not and: [(used at: register) !!= aRange]) + ifTrue: [self error: 'register ' , register , ' is not free']. + allocation at: aRange put: register. + free remove: register ifAbsent: []. + used at: register put: aRange +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assignRegisterTo: instruction in: aRange + | register | + register := allocation at: aRange ifAbsent: [ + free isEmpty + ifTrue: [self spillALiveRangeInUseAfter: instruction] + ifFalse: [free last]]. + "register == edx ifTrue: [self halt]." + self assign: register to: aRange +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assureLiveRangeOf: operand startingAt: anInstruction + | range | + range := self assureLiveRangeStartingAt: anInstruction in: currentBlock. + liveRanges at: operand put: range +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assureLiveRangeStartingAt: anInstruction + ^self assureLiveRangeStartingAt: anInstruction in: currentBlock +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assureLiveRangeStartingAt: anInstruction in: block + | range | + range := OSimpleLiveRange new definedAt: anInstruction in: block. + liveRanges at: anInstruction put: range. + ^range +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeExpirationOf: instruction + | range | + range := self unifiedLiveRangeOf: instruction. + range expirationPoints do: [:operation | self kill: range at: operation] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeExpirations + firstBlock + instructionsWithSuccessorsDo: [:instruction | self + computeExpirationOf: instruction] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeInterferenceGraph + liveRanges do: [:range | self computeInterferencesOf: range] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeInterferencesOf: range + range instructionsDo: [:instruction | | other | + other := self liveRangeOf: instruction. + self range: range interferes: other] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeLiveRanges + firstBlock + reversePostOrderDo: [:block | self addLiveRangesOf: block]; + reversePostOrderDo: [:block | self + currentBlock: block; + computeLiveRangesOf: block]. + self computeExpirations +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +computeLiveRangesOf: block + block firstInstruction acceptVisitor: self +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +currentBlock: aBasicBlock + currentBlock := aBasicBlock +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +doAllocation + | record | + " record := self activationRecord. + record isLoadImplicit ifFalse: [free remove: ebp]." + self computeLiveRanges; allocateLiveRanges; reserveSpaceForLocals. + ^allocation +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock: aBasicBlock + firstBlock := aBasicBlock +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +free: range + | register | + register := allocation at: range ifAbsent: [^self]. + (free includes: register) ifTrue: [^self]. + (used at: register) == range ifFalse: [^self]. + "register == ecx ifTrue: [self halt]." + free add: register. + used removeKey: register. + ^register +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + allocation := IdentityDictionary new. + liveRanges := IdentityDictionary new. + unifiedLiveRanges := IdentityDictionary new. + expirations := IdentityDictionary new. + locals := 2. + used := Dictionary new. + usedOut := Dictionary new +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertCopyResultAfter: messageSend + | copy range | + copy := OUnaryOperation receiver: messageSend name: #copyResult. + messageSend + afterInsert: copy; + replaceAllUsesWith: copy; + addUse: copy at: #receiver. + range := self liveRangeOf: messageSend. + range definition: copy. + liveRanges at: copy put: range. + unifiedLiveRanges + at: messageSend + ifPresent: [:unified | unifiedLiveRanges at: copy put: unified] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertCopyToR: anInstruction before: inst + | copy range | + copy := OUnaryOperation receiver: anInstruction name: #copy. + anInstruction addUse: copy at: #receiver. + inst beforeInsert: copy. + range := self unifiedLiveRangeOf: anInstruction. + liveRanges at: copy put: range. + allocation at: copy put: abi regR +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertLoadBefore: use at: block changing: operand + | stack load range definition | + use isPhi ifTrue: [ + range := self liveRangeOf: use. + range beSpilled. + ^self]. + stack := used at: abi regFP. + load := OBinaryConstantOperation + left: stack anyDefinition + right: 1 - locals + name: #_basicAt:. + stack anyDefinition addUse: load at: #left. + use beforeInsert: load. + definition := operand definition. + operand replaceUseWith: load. + load addUse: use at: operand name. + range := self assureLiveRangeStartingAt: load. + range addUseFrom: use at: block. + self kill: range at: use. + allocation + at: definition + ifPresent: [:register | allocation at: load put: register] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPop: anInstruction to: register after: messageSend + | pop range | + pop := OUnaryOperation receiver: nil name: #pop. + messageSend afterInsert: pop. + range := self unifiedLiveRangeOf: anInstruction. + liveRanges at: pop put: range. + allocation at: pop put: register +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPush: anInstruction before: inst + | push | + push := OUnaryOperation receiver: anInstruction name: #push. + anInstruction addUse: push at: #receiver. + inst beforeInsert: push +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertStoreAfter: definition at: block + | stack store range | + unifiedLiveRanges removeKey: definition ifAbsent: []. + definition isPhi ifTrue: [^self]. + stack := used at: abi regFP. + store := OTernaryOperation + receiver: stack anyDefinition + left: 1 - locals + right: definition + name: #_basicAt:put:. + stack anyDefinition addUse: store at: #receiver. + definition addUse: store at: #right. + definition afterInsert: store. + range := self assureLiveRangeStartingAt: definition. + range addUseFrom: store at: block. + stack addUseFrom: store at: block. + self kill: range at: store. + range := self assureLiveRangeStartingAt: store. + self kill: range at: store +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isFree: register + ^free includes: register +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSpilled: register + ^false +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +kill: range at: instruction + | expiring | + (range class = OSimpleLiveRange or: [range class == OComposedLiveRange]) + ifFalse: [self halt]. + expiring := expirations + at: instruction + ifAbsentPut: [OrderedCollection new]. + expiring add: range +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +liveRangeOf: value + ^liveRanges at: value +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +preallocateImplicitVariables + firstBlock instructionsDo: [:inst | | range register | + inst isLoadImplicit ifFalse: [^self]. + range := self unifiedLiveRangeOf: inst. + register := inst source. + register ifNotNil: [allocation at: range put: register]] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +rangesEndingAt: instruction + ^expirations at: instruction ifAbsent: [OrderedCollection new] +! ! + +!OptimizingRegisterAllocator methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +recalculateRegisterUsage + | incoming recalculated | + currentBlock predecessors size = 0 ifTrue: [^self]. + incoming := (currentBlock predecessors + select: [:block | usedOut includesKey: block]) + collect: [:block | usedOut at: block]. + recalculated := incoming first. + used := recalculated select: [:assoc | assoc value isLiveAt: currentBlock]. + free := OrderedCollection new: 10. + free + add: abi regS; + add: abi regT; + add: abi regA; + add: abi regR; + add: abi regFP; + removeAll: used keys +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +repairToRespectABI: messageSend with: range + | result clobbered receiver spillPoint | + result := allocation at: messageSend ifAbsent: nil. + clobbered := (used copy + removeKey: abi regFP ifAbsent: []; + removeKey: result ifAbsent: []; + yourself) associations. + spillPoint := messageSend arguments size > 0 + ifTrue: [messageSend arguments first] + ifFalse: [messageSend]. + clobbered do: [:assoc | + self + insertPush: assoc value anyDefinition before: spillPoint; + insertPop: assoc value anyDefinition to: assoc key after: messageSend]. + receiver := allocation at: messageSend receiver. + receiver == abi regR + ifFalse: [self insertCopyToR: messageSend receiver before: messageSend]. + (result !!= nil and: [result !!= abi regR]) + ifTrue: [self insertCopyResultAfter: messageSend] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +reserveSpaceForLocals + self activationRecord temporaries: locals - 2 +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +spillALiveRangeInUseAfter: instruction + | freed register | + freed := self usedRangeReadLastAfter: instruction. + locals := locals + 1. + self splitRange: freed. + register := self free: freed. + ^register +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +splitRange: aLiveRange + | real | + real := self unifiedLiveRangeOfRange: aLiveRange. + real definitionsWithBlocksDo: [:definition :block | + definition allUses + do: [:operand | self + insertLoadBefore: operand instruction + at: nil + changing: operand]. + self insertStoreAfter: definition at: block] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +unifiedLiveRangeOf: anInstruction + ^unifiedLiveRanges + at: anInstruction + ifAbsent: [liveRanges at: anInstruction] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +unifiedLiveRangeOfRange: aLiveRange + ^unifiedLiveRanges at: aLiveRange ifAbsent: [aLiveRange] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +unify: anInstruction liveRangeTo: unified + | range | + range := self unifiedLiveRangeOf: anInstruction. + range = unified ifTrue: [^self]. + unified addAll: range simpleRanges. + unified allDefinitions + do: [:instruction | unifiedLiveRanges at: instruction put: unified] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +use: operand from: anInstruction + self use: operand from: anInstruction in: currentBlock +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +use: operand from: anInstruction in: block + | range | + range := self liveRangeOf: operand. + range addUseFrom: anInstruction at: block +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usedRangeLessAccessed + | ranges | + ranges := (used copy removeKey: abi regFP) values asOrderedCollection. + ^ranges + min: [:range | (range allDefinitions , range allUses reject: #isPhi) size] +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usedRangeReadLast + | ranges | + ranges := (used copy removeKey: abi regFP) values asOrderedCollection. + currentBlock + instructionsWithReversePostOrderSuccessorsDo: [:instruction | | candidate | + candidate := ranges first. + ranges removeAllSuchThat: [:range | + range allDefinitions + anySatisfy: [:definition | instruction usesResultOf: definition]]. + ranges size = 1 ifTrue: [^ranges first]. + ranges size = 0 ifTrue: [^candidate]]. + self ASSERT: false +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +usedRangeReadLastAfter: first + | ranges | + ranges := (used copy removeKey: abi regFP) values asOrderedCollection. + currentBlock + instructionsAfter: first + withReversePostOrderSuccessorsDo: [:instruction | | candidate | + candidate := ranges first. + ranges removeAllSuchThat: [:range | range isUsedBy: instruction]. + ranges size = 1 ifTrue: [^ranges first]. + ranges size = 0 ifTrue: [^candidate]]. + ^ranges first +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithConstant: instruction + self use: instruction left from: instruction +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithVariable: instruction + self + use: instruction left from: instruction; + use: instruction right from: instruction +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJump: instruction + +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpFalse: instruction + self use: instruction variable from: instruction +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpTrue: instruction + self use: instruction variable from: instruction +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadConstant: instruction + +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadImplicit: instruction + +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitMessageSend: instruction + self + use: instruction receiver + from: instruction + "instruction arguments + do: [:operation | self use: operation from: instruction]" +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitNullary: instruction + +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitPhi: instruction + | unified | + unified := OComposedLiveRange new. + instruction variables do: [:source | + self + use: source from: instruction; + unify: source liveRangeTo: unified]. + self unify: instruction liveRangeTo: unified +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitReturn: instruction + self + use: instruction source from: instruction; + use: self activationRecord from: instruction +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitTernary: instruction + self use: instruction receiver from: instruction. + instruction left isInteger + ifFalse: [self use: instruction left from: instruction]. + self use: instruction right from: instruction +! ! + +!OptimizingRegisterAllocator methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitUnary: instruction + self use: instruction receiver from: instruction +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingRegisterAllocator class' category: #OCompiler! +OptimizingRegisterAllocator class + instanceVariableNames: ''! + +!OptimizingRegisterAllocator class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OptimizingRegisterAllocator initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingSSAReconstructor.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingSSAReconstructor.Class.st new file mode 100644 index 00000000..c2105070 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingSSAReconstructor.Class.st @@ -0,0 +1,98 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingSSAReconstructor category: #OCompiler! +Object subclass: #OptimizingSSAReconstructor + instanceVariableNames: 'firstBlock variable reloads idoms iteratedFrontiers insertedPhis blocks' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingSSAReconstructor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingSSAReconstructor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +definitionInBlockFrom: instruction + instruction + reverseDo: [:current | (variable == current + or: [reloads includes: current]) + ifTrue: [^current]]. + ^nil +! ! + +!OptimizingSSAReconstructor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock: block + firstBlock := block. + idoms := firstBlock dominatorTree allImmediateDominators +! ! + +!OptimizingSSAReconstructor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPhiAt: block + ^insertedPhis at: block ifAbsentPut: [| arguments phi predecessors | + predecessors := block predecessors. + arguments := predecessors collect: [:pred | | search | + search := pred lastInstruction. + self reachingDefinitionFrom: search at: pred]. + phi := OPhi withAll: arguments in: predecessors. + arguments with: predecessors do: [:var :pred | var addUse: phi at: pred]. + block addFront: phi. + phi] +! ! + +!OptimizingSSAReconstructor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +reachingDefinitionFrom: instruction at: block + | current search | + current := block. + search := instruction. + [| def | + def := self definitionInBlockFrom: search. + def ifNotNil: [^def]. + (iteratedFrontiers includes: current) ifTrue: [^self insertPhiAt: current]. + current := idoms at: current. + search := current lastInstruction] repeat +! ! + +!OptimizingSSAReconstructor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +reconstructSSA + | frontiers reloadBlocks uses | + frontiers := firstBlock dominanceFrontiersUsing: idoms. + reloadBlocks := reloads collect: [:reload | blocks at: reload]. + iteratedFrontiers := firstBlock + iteratedDominanceFrontiersOf: reloadBlocks + using: frontiers. + uses := variable allUses. + uses do: [:use | | search block def user | + user := use user. + user isPhi + ifTrue: [ + block := use name. + search := use name lastInstruction] + ifFalse: [ + block := blocks at: user. + search := user prev]. + def := self reachingDefinitionFrom: search at: block. + use disolveReplacingWith: def] +! ! + +!OptimizingSSAReconstructor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +setupFor: anInstruction with: redefinitions + | users | + insertedPhis := Dictionary new. + variable := anInstruction. + reloads := redefinitions. + blocks := Dictionary new. + users := variable allUses collect: #user. + firstBlock withSuccessorsDo: [:block | + block instructionsDo: [:instr | + ((reloads includes: instr) or: [users includes: instr]) + ifTrue: [blocks at: instr put: block]]] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingSSAReconstructor class' category: #OCompiler! +OptimizingSSAReconstructor class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingTwoAddressEnforcer.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingTwoAddressEnforcer.Class.st new file mode 100644 index 00000000..f84bc9e4 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingTwoAddressEnforcer.Class.st @@ -0,0 +1,182 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingTwoAddressEnforcer category: #OCompiler! +Object subclass: #OptimizingTwoAddressEnforcer + instanceVariableNames: 'allocation firstBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingTwoAddressEnforcer commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocation: aDictionary + allocation := aDictionary +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +convert: instruction copyingLeftInto: dest + | load | + load := OUnaryOperation receiver: instruction left name: #copy. + instruction left addUse: load at: #receiver. + instruction beforeInsert: load; left: load. + allocation at: load put: dest +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +convert: instruction copyingReceiverInto: dest + | load | + load := OUnaryOperation receiver: instruction receiver name: #copy. + instruction receiver + addUse: load at: #receiver; + removeUse: instruction. + instruction beforeInsert: load; receiver: load. + allocation at: load put: dest +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +doEnforce + firstBlock + withSuccessorsDo: [:block | block firstInstruction acceptVisitor: self] +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstBlock: block + firstBlock := block +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertCopy: instruction rightInto: dest + | load | + load := OUnaryOperation receiver: instruction right name: #copy. + instruction addUse: load at: #receiver. + instruction afterInsert: load. + allocation at: load put: dest +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +invertMinus: minus with: left with: right + | negate | + negate := OUnaryOperation receiver: minus right name: #negate. + minus beforeInsert: negate. + allocation at: negate put: right. + minus right + removeUse: minus; + addUse: negate at: #receiver. + negate addUse: minus at: #right. + minus right: negate; name: #'+'; swapOperands +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithConstant: instruction + | left dest | + (#(_basicAt: _smallSize:) includes: instruction name) ifTrue: [^self]. + left := allocation at: instruction left. + dest := allocation at: instruction. + left == dest ifTrue: [^self]. + self convert: instruction copyingLeftInto: dest +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithVariable: instruction + | left right dest temp | + left := allocation at: instruction left. + right := allocation at: instruction right. + dest := allocation at: instruction ifAbsent: [^self]. + left == dest ifTrue: [^self]. + right == dest ifTrue: [ + (#(< <= = == > >= _transferControlTo: _basicAt: _byteAt: _basicFlags: _smallSize: _extendedFlags:) + includes: instruction name) + ifTrue: [^self]. + instruction name == #'-' + ifTrue: [^self invertMinus: instruction with: left with: right]. + (#(+ bitAnd: bitOr: & ) includes: instruction name) + ifTrue: [ + temp := instruction left. + instruction left: instruction right. + ^instruction right: temp] + ifFalse: [self halt]]. + self convert: instruction copyingLeftInto: dest +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJump: instruction + +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpFalse: instruction + +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpTrue: instruction + +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadConstant: instruction + +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadImplicit: instruction + +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitMessageSend: instruction + +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitNullary: instruction + +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitPhi: instruction + +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitReturn: instruction + +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitTernary: instruction + | receiver left right dest | + (#(_basicAt:put: _basicULongAt:put: _byteAt:put: _objectAtOffset:put:) + includes: instruction name) + ifTrue: [^self]. + receiver := allocation at: instruction receiver. + left := allocation at: instruction left. + right := allocation at: instruction right. + dest := allocation at: instruction. + right == dest ifTrue: [^self halt]. + self insertCopy: instruction rightInto: dest +! ! + +!OptimizingTwoAddressEnforcer methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitUnary: instruction + | receiver dest | + (#(_asNative _asObject _asPointer _asSmallInteger) + includes: instruction name) + ifFalse: [^self]. + receiver := allocation at: instruction receiver. + dest := allocation at: instruction. + receiver == dest ifTrue: [^self]. + self convert: instruction copyingReceiverInto: dest +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingTwoAddressEnforcer class' category: #OCompiler! +OptimizingTwoAddressEnforcer class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingUsesVerifier.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingUsesVerifier.Class.st new file mode 100644 index 00000000..bb35933e --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingUsesVerifier.Class.st @@ -0,0 +1,106 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingUsesVerifier category: #OCompiler! +Object subclass: #OptimizingUsesVerifier + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingUsesVerifier commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +verify: definition usedBy: user + definition isInteger ifTrue: [^self]. + definition usesDo: [:use | use instruction == user ifTrue: [^self]]. + self error: 'Corrupted instruction usage' +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +verifyFrom: firstBlock + firstBlock + instructionsWithSuccessorsDo: [:instruction | instruction + acceptVisitor: self] +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithConstant: instruction + self verify: instruction left usedBy: instruction +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithVariable: instruction + self + verify: instruction left usedBy: instruction; + verify: instruction right usedBy: instruction +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJump: instruction + +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpFalse: instruction + self verify: instruction variable usedBy: instruction +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpTrue: instruction + self verify: instruction variable usedBy: instruction +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadConstant: instruction + +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadImplicit: instruction + +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitMessageSend: instruction + self verify: instruction receiver usedBy: instruction +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitNullary: instruction + +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitPhi: instruction + instruction variables + do: [:operation | self verify: operation usedBy: instruction] +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitReturn: instruction + self verify: instruction source usedBy: instruction +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitTernary: instruction + self + verify: instruction receiver usedBy: instruction; + verify: instruction left usedBy: instruction; + verify: instruction right usedBy: instruction +! ! + +!OptimizingUsesVerifier methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitUnary: instruction + self verify: instruction receiver usedBy: instruction +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingUsesVerifier class' category: #OCompiler! +OptimizingUsesVerifier class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingValueNumbering.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingValueNumbering.Class.st new file mode 100644 index 00000000..e61f7e75 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingValueNumbering.Class.st @@ -0,0 +1,281 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingValueNumbering category: #OCompiler! +Object subclass: #OptimizingValueNumbering + instanceVariableNames: 'firstBlock currentBlock names hashes hashesOut' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingValueNumbering commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingValueNumbering methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +addNewName: instruction + ^names at: instruction put: '{v' , names size printString , '}' +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +hashOfLoadConstant: instruction + ^[instruction value printString] on: Error do: [^nil] +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +hashOfUnary: instruction + | receiver | + receiver := self nameOf: instruction receiver. + ^receiver , instruction name +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isCommutative: name + ^name = #'+' or: [name = #'*'] +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isStillAlive: block + ^block withPredecessors includes: firstBlock +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +nameOf: instruction + ^names at: instruction +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +processMemoryStore: value as: storeHash andLoads: loadHash + hashes + at: loadHash + put: value + "facil hashes at: storeHash ifPresent: [:mapping | (mapping value livesInSameBlockThan: store) ifTrue: [mapping value dissolve]]" + "dificil hashes at: storeHash ifPresent: [:mapping | postDominatorTree does: blockOf dominate: currentBlock ifTrue: [mapping value dissolve]]" +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +resultOfBinaryWithConstants: aBinaryInstruction + | operation left right | + operation := aBinaryInstruction name. + left := aBinaryInstruction left value. + right := aBinaryInstruction right value. + operation = #'+' ifTrue: [^left + right]. + operation = #'-' ifTrue: [^left - right]. + operation = #'*' ifTrue: [^left * right]. + operation = #'//' ifTrue: [^left // right]. + operation = #'=' ifTrue: [^left = right]. + self halt +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +unifyPredecessorHashes + | incoming any | + hashes := Dictionary new. + currentBlock predecessors size = 0 ifTrue: [^self]. + incoming := currentBlock predecessors + collect: [:pred | hashesOut at: pred ifAbsent: [Dictionary new]]. + any := incoming removeLast. + any keysAndValuesDo: [:hash :value | | unanimous | + unanimous := incoming + conform: [:dict | dict + at: hash + ifAbsent: false + ifPresent: [:prev | prev = value]]. + unanimous ifTrue: [hashes at: hash put: value]] +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueBranchTo: aBasicBlock + | source last comparison hash name | + aBasicBlock predecessors size !!= 1 ifTrue: [^self]. + source := aBasicBlock predecessors first. + last := source lastInstruction. + last isConditionalJump ifFalse: [^self]. + comparison := last variable. + name := self nameOf: comparison. + hash := 'branch' , name. + last target == aBasicBlock + ifTrue: [hashes at: hash put: last isJumpTrue] + ifFalse: [hashes at: hash put: last isJumpFalse] +! ! + +!OptimizingValueNumbering methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueOf: hash be: instruction + hashes at: hash ifPresent: [:value | | copy | + copy := instruction replaceWithCopyOf: value. + self addNewName: copy. + ^copy == value ifFalse: [ + (copy isUnaryOperation and: [copy name = #copy]) + ifTrue: [hashes at: (self hashOfUnary: copy) put: instruction]. + copy isConstant + ifTrue: [hashes at: (self hashOfLoadConstant: copy) put: instruction]]]. + hashes at: hash put: instruction +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithConstant: instruction + | left right hash selector load temp value replacement | + left := self nameOf: instruction left. + right := instruction right printString. + (self isCommutative: instruction name) ifTrue: [ + left > right ifTrue: [ + temp := left. + left := right. + right := temp]]. + hash := left , instruction name , right. + (#(_basicFlags: _extendedFlags:) includes: instruction name) + ifTrue: [ + selector := instruction name allButLast: 1. + load := left , selector. + self processMemoryStore: instruction right as: hash andLoads: load] + ifFalse: [ + (instruction left isConstant and: instruction name !!= #_basicAt:) ifTrue: [ + value := self resultOfBinaryWithConstants: instruction. + replacement := OLoadConstant valued: value. + instruction dissolveReplacingWith: replacement. + ^self + addNewName: replacement; + visitLoadConstant: replacement; + valueOf: hash be: replacement]. + self valueOf: hash be: instruction] +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithVariable: instruction + | left right hash selector load temp | + left := self nameOf: instruction left. + right := self nameOf: instruction right. + (self isCommutative: instruction name) ifTrue: [ + left > right ifTrue: [ + temp := left. + left := right. + right := temp]]. + hash := left , instruction name , right. + (#(_basicFlags: _extendedFlags:) includes: instruction name) + ifTrue: [ + selector := instruction name allButLast: 1. + load := left , selector. + self processMemoryStore: instruction right as: hash andLoads: load] + ifFalse: [self valueOf: hash be: instruction] +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBranch: branch + | hash receiver | + receiver := self nameOf: branch variable. + hash := 'branch' , receiver. + hashes at: hash ifPresent: [:outcome | + outcome isBoolean + ifTrue: [branch replaceWithUnconditional: outcome in: currentBlock]] +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJump: aJumpInstruction + +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpFalse: branch + self visitBranch: branch +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpTrue: branch + self visitBranch: branch +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadConstant: instruction + | hash | + hash := self hashOfLoadConstant: instruction. + hash ifNil: [self]. + self valueOf: hash be: instruction +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadImplicit: instruction + +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitMessageSend: instruction + | loads | + loads := names keys select: [:instr | + instr isPrimitiveOperation + and: [#(_basicAt: _byteAt: _basicFlags) includes: instr name]]. + loads do: [:load | hashes removeAllSuchThat: [:value | value = load]] +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitNullary: instruction + +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitPhi: instruction + +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitReturn: instruction + +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitTernary: instruction + | receiver operand left right hash load | + receiver := self nameOf: instruction receiver. + operand := instruction left. + left := operand isInstruction + ifTrue: [self nameOf: operand] + ifFalse: [operand printString]. + right := self nameOf: instruction right. + hash := receiver , instruction name , left , right. + (#(_basicAt:put: _byteAt:put:) includes: instruction name) + ifTrue: [| selector | + selector := instruction name allButLast: 4. + load := receiver , selector , left. + self processMemoryStore: instruction right as: hash andLoads: load] + ifFalse: [^self valueOf: hash be: instruction] +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitUnary: instruction + | hash | + (#(push) includes: instruction name) ifTrue: [^self]. + hash := self hashOfUnary: instruction. + self valueOf: hash be: instruction +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +workFrom: aBasicBlock + | count | + hashes := Dictionary new. + hashesOut := Dictionary new. + names := Dictionary new. + firstBlock := aBasicBlock. + count := 0. + aBasicBlock instructionsWithSuccessorsDo: [:inst | + names at: inst put: '{v' , count printString , '}'. + count := count + 1]. + aBasicBlock withSuccessorsPostOrder + reverseDo: [:block | self workOn: block] +! ! + +!OptimizingValueNumbering methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +workOn: aBlock + (self isStillAlive: aBlock) ifFalse: [^self]. + currentBlock := aBlock. + self unifyPredecessorHashes. + self valueBranchTo: aBlock. + currentBlock firstInstruction acceptVisitor: self. + hashesOut at: aBlock put: hashes copy +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingValueNumbering class' category: #OCompiler! +OptimizingValueNumbering class + instanceVariableNames: ''! + + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingVariableBinder.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingVariableBinder.Class.st new file mode 100644 index 00000000..dcd5c2e1 --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingVariableBinder.Class.st @@ -0,0 +1,372 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingVariableBinder category: #OCompiler! +Object subclass: #OptimizingVariableBinder + instanceVariableNames: 'definitions currentBlock dominatorTree immediateDominators dominanceFrontiers pendingReads pendingPhis abi' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingVariableBinder commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingVariableBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +abi: anAbi + abi := anAbi +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +define: value as: name + self define: value as: name in: currentBlock +! ! + +!OptimizingVariableBinder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +define: value as: name in: block + | here | + here := definitions at: block ifAbsentPut: [Dictionary new]. + here at: name put: value +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +definitionOf: name + ^self definitionOf: name from: currentBlock +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +definitionOf: name before: block + | instruction current | + instruction := block firstInstruction. + [instruction isPhi] whileTrue: [ + instruction variables first = name ifTrue: [^instruction]. + instruction := instruction next]. + current := block. + [ + current := immediateDominators + at: current + ifAbsent: [self error: 'undefined variable <' , name , '>']. + current notNil] + whileTrue: [ + definitions + at: current + ifPresent: [:here | here at: name ifPresent: [:value | ^value]]] +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +definitionOf: name from: block + | current | + current := block. + [current notNil] whileTrue: [ + definitions + at: current + ifPresent: [:here | here at: name ifPresent: [:value | ^value]]. + current := immediateDominators + at: current + ifAbsent: [^block lastValue + "BMNullaryOperation + name: 'nop' + self error: 'undefined variable <' , name , '>'"]] +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +definitionOf: name in: block + definitions + at: block + ifPresent: [:here | here at: name ifPresent: [:value | ^value]]. + ^nil +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +doBindingFrom: firstBlock + dominatorTree := firstBlock dominatorTree. + immediateDominators := dominatorTree allImmediateDominators. + dominanceFrontiers := firstBlock + dominanceFrontiersUsing: immediateDominators. + firstBlock reversePostOrderDo: [:block | + currentBlock := block. + block firstInstruction acceptVisitor: self]. + self resolvePendingReads; rewritePhis +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + definitions := Dictionary new. + pendingReads := OrderedCollection new. + pendingPhis := OrderedCollection new +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertPhiOf: name at: block + | size variables phi | + (self definitionOf: name in: block) ifNotNil: [^self]. + size := block predecessors size. + variables := (Array new: size) + atAllPut: name; + asOrderedCollection. + phi := OPhi withAll: variables in: block predecessors. + block firstInstruction beforeInsert: phi. + pendingPhis add: phi -> block. + self define: phi as: name in: block +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsForWriting: aWriteVariable + | binding | + binding := aWriteVariable binding. + binding isTemporary + ifTrue: [^self instructionsForWriting: aWriteVariable toTemporary: binding]. + binding isInstVar + ifTrue: [^self + instructionsForWriting: aWriteVariable + toInstanceVariable: binding]. + binding refersToAssoc + ifTrue: [^self + instructionsForWriting: aWriteVariable + toAssociation: binding]. + self halt +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsForWriting: aWriteVariable toAssociation: binding + | global write | + global := OLoadConstant valued: binding association. + write := OTernaryOperation + receiver: global + left: 1 + right: aWriteVariable source + name: #_basicAt:put:. + global addUse: write at: #receiver. + aWriteVariable source addUse: write at: #right. + aWriteVariable beforeInsert: global; dissolveReplacingWith: write +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsForWriting: aWriteVariable toInstanceVariable: binding + | this write | + this := self definitionOf: #self. + write := OTernaryOperation + receiver: this + left: binding index + right: aWriteVariable source + name: #_basicAt:put:. + this addUse: write at: #receiver. + aWriteVariable source addUse: write at: #right. + aWriteVariable dissolveReplacingWith: write +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructionsForWriting: aWriteVariable toTemporary: binding + self define: aWriteVariable source as: binding name asSymbol. + aWriteVariable dissolve. + (dominanceFrontiers at: currentBlock) + do: [:block | self insertPhiOf: binding name asSymbol at: block] +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolve: aReadVariable asArgument: binding + | source | + source := self definitionOf: binding name asSymbol. + aReadVariable replaceAllUsesWith: source; dissolve +! ! + +!OptimizingVariableBinder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolve: aReadVariable asAssociationValue: binding + | global read value name load | + name := binding association key. + (name == #WordSize or: [name == #WordSizeShift]) ifTrue: [ + value := name == #WordSize + ifTrue: [abi wordSize] + ifFalse: [abi wordSizeShift]. + load := OLoadConstant valued: value. + ^aReadVariable dissolveReplacingWith: load]. + binding isPoolVariableBinding + ifTrue: [ + load := OLoadConstant valued: binding association value. + aReadVariable dissolveReplacingWith: load] + ifFalse: [ + global := OLoadConstant valued: binding association. + read := OBinaryConstantOperation left: global right: 1 name: #_basicAt:. + global addUse: read at: #left. + aReadVariable beforeInsert: global; dissolveReplacingWith: read] +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolve: aReadVariable asInstanceVar: binding + | receiver index load | + receiver := self definitionOf: #self. + " index := method classField indexOfSlot: name." + index := binding index. + load := OBinaryConstantOperation + left: receiver + right: index + name: #_basicAt:. + receiver addUse: load at: #left. + aReadVariable dissolveReplacingWith: load +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolve: aReadVariable asLiteral: binding + | name value constant | + name := binding name asSymbol. + value := self valueOfSpecial: name. + constant := OLoadConstant valued: value. + aReadVariable dissolveReplacingWith: constant +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolve: aReadVariable asTemporary: binding + | source | + source := self definitionOf: binding name asSymbol in: currentBlock. + source + ifNil: [pendingReads add: aReadVariable -> currentBlock] + ifNotNil: [aReadVariable replaceAllUsesWith: source; dissolve] +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolvePendingReads + pendingReads do: [:association | | read block source | + read := association key. + block := association value. + source := self definitionOf: read binding name asSymbol before: block. + read replaceWithCopyOf: source] +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolveSelf: aReadVariable + | receiver | + receiver := self definitionOf: #self. + ^aReadVariable replaceAllUsesWith: receiver; dissolve +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +rewritePhis + pendingPhis do: [:association | | phi block | + phi := association key. + block := association value. + (phi livesAfter: phi orOutOf: block) + ifTrue: [ + block predecessors withIndexDo: [:predecessor :i | | name source | + name := phi variables at: i. + source := self definitionOf: name from: predecessor. + phi variables at: i put: source. + source addUse: phi at: predecessor]] + ifFalse: [phi clearVariables; dissolve]] +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueOfSpecial: name + name == #true ifTrue: [^true]. + name == #false ifTrue: [^false]. + name == #nil ifTrue: [^nil]. + self halt +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithConstant: instruction + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBinaryWithVariable: instruction + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitDefineArgument: instruction + self define: instruction as: instruction name +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJump: aJumpInstruction + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpFalse: aJumpInstruction + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitJumpTrue: aJumpInstruction + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLoadConstant: aLoadImplicit + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitMessageSend: aMessageSend + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitPhi: aPhi + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitReadVariable: aReadVariable + | binding | + self ASSERT: (aReadVariable binding isKindOf: Binding). + binding := aReadVariable binding. + binding isTemporary + ifTrue: [^self resolve: aReadVariable asTemporary: binding]. + binding isArgument + ifTrue: [^self resolve: aReadVariable asArgument: binding]. + binding isSelf ifTrue: [^self resolveSelf: aReadVariable]. + binding isLiteral ifTrue: [^self resolve: aReadVariable asLiteral: binding]. + binding isInstVar + ifTrue: [^self resolve: aReadVariable asInstanceVar: binding]. + binding refersToAssoc + ifTrue: [^self resolve: aReadVariable asAssociationValue: binding]. + self ASSERT: false +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitReturn: aReturnInstruction + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitTernary: instruction + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitUnary: instruction + +! ! + +!OptimizingVariableBinder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitWriteVariable: aWriteVariable + self ASSERT: (aWriteVariable binding isKindOf: Binding). + self instructionsForWriting: aWriteVariable +! ! + +!OptimizingVariableBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +wordSize + ^abi wordSize +! ! + +!OptimizingVariableBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +wordSizeShift + ^abi wordSizeShift +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingVariableBinder class' category: #OCompiler! +OptimizingVariableBinder class + instanceVariableNames: ''! + +!OptimizingVariableBinder class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OptimizingVariableBinder initialize! + diff --git a/modules/LMR/Nativizer/OCompiler/OptimizingVisitor.Class.st b/modules/LMR/Nativizer/OCompiler/OptimizingVisitor.Class.st new file mode 100644 index 00000000..82b2152a --- /dev/null +++ b/modules/LMR/Nativizer/OCompiler/OptimizingVisitor.Class.st @@ -0,0 +1,191 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #OptimizingVisitor category: #OCompiler! +ParseTreeVisitor subclass: #OptimizingVisitor + instanceVariableNames: 'firstBlock currentBlock isReceiver argumentsCount' + classVariableNames: '' + poolDictionaries: '' + category: 'OCompiler'! +!OptimizingVisitor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + firstBlock := OBasicBlock new. + currentBlock := firstBlock. + isReceiver := true +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertDefineArgument: name + | instruction | + instruction := ODefineArgument named: name. + currentBlock add: instruction. + ^instruction +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +insertReturnSelf + | receiver frame instruction | + receiver := firstBlock firstInstruction next. + frame := firstBlock firstInstruction. + instruction := OReturn new + source: receiver; + frame: frame; + argumentsCount: argumentsCount. + receiver addUse: instruction at: #source. + frame addUse: instruction at: #frame. + currentBlock add: instruction. + ^instruction +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +isReceiver + ^isReceiver +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +store: operation into: anIdentifierNode + | instruction | + instruction := OWriteVariable + binding: anIdentifierNode binding + valued: operation. + operation addUse: instruction at: #source. + currentBlock add: instruction. + ^instruction +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visit: aParseNode + super visit: aParseNode. + ^firstBlock +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitAssignment: anAssignmentNode + | result | + result := anAssignmentNode expression acceptVisitor: self. + anAssignmentNode assignees do: [:node | self store: result into: node] +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitBlock: aBlockNode + | previous cfg | + previous := currentBlock. + cfg := OBasicBlock new. + currentBlock := cfg. + self visitScript: aBlockNode. + currentBlock := previous. + ^OBlockClosure containing: cfg +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitCascade: aCascadeNode + | result | + aCascadeNode receiver acceptVisitor: self. + aCascadeNode messages do: [:node | result := node acceptVisitor: self]. + ^result +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitCascadeReceiver: aCascadeReceiverNode + ^aCascadeReceiverNode receiver acceptVisitor: self +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitIdentifier: anIdentifierNode + | load | + load := OReadVariable binding: anIdentifierNode binding. + currentBlock add: load. + ^load +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitLiteral: aLiteralNode + | load | + load := OLoadConstant valued: aLiteralNode value. + currentBlock add: load. + ^load +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitMessage: aMessageNode + | receiver arguments send block | + block := currentBlock. + receiver := aMessageNode receiver acceptVisitor: self. + arguments := aMessageNode arguments + collect: [:node | node acceptVisitor: self]. + send := OMessageSend + receiver: receiver + selector: aMessageNode selector value asSymbol + arguments: arguments. + receiver addUse: send at: #receiver. + arguments + withIndexDo: [:argument :i | argument isInstruction + ifTrue: [argument addUse: send at: i]]. + block add: send. + ^send +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitMethod: aMethodNode + | last | + self insertDefineArgument: #activationRecord; insertDefineArgument: #self. + aMethodNode arguments + do: [:node | self insertDefineArgument: node value asSymbol]. + argumentsCount := aMethodNode arguments size. + self visitScript: aMethodNode. + last := currentBlock lastValue. + last isReturn ifFalse: [self insertReturnSelf] +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitNumericLiteral: aNumericLiteralNode + ^self visitLiteral: aNumericLiteralNode +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitReturn: aReturnNode + | source frame instruction | + source := aReturnNode expression acceptVisitor: self. + frame := firstBlock firstInstruction. + instruction := OReturn new + source: source; + frame: frame; + argumentsCount: argumentsCount. + source addUse: instruction at: #source. + frame addUse: instruction at: #frame. + currentBlock add: instruction. + ^instruction +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitScript: aScriptNode + [ + aScriptNode arguments do: [:node | node acceptVisitor: self]. + aScriptNode temporaries do: [:node | node acceptVisitor: self]]. + aScriptNode statements do: [:node | node acceptVisitor: self] +! ! + +!OptimizingVisitor methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +visitSelector: aSelectorNode + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OptimizingVisitor class' category: #OCompiler! +OptimizingVisitor class + instanceVariableNames: ''! + +!OptimizingVisitor class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + ^self basicNew initialize +! ! + + +OptimizingVisitor initialize! + diff --git a/modules/LMR/Nativizer/TemplateJIT.Class.st b/modules/LMR/Nativizer/TemplateJIT.Class.st new file mode 100644 index 00000000..d4ac726e --- /dev/null +++ b/modules/LMR/Nativizer/TemplateJIT.Class.st @@ -0,0 +1,751 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TemplateJIT category: #Nativization! +Object subclass: #TemplateJIT + instanceVariableNames: 'environment method remainingBlocks safepointCheck mainCode stackCount fallbacks activeScript assembler' + classVariableNames: '' + poolDictionaries: 'ClosureElementTypes' + category: 'Nativization'! +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +addFallback: aBlock + fallbacks add: aBlock +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +argumentAt: index in: envIndex + envIndex ifNil: [ ^ self argumentInStackAt: index ]. + envIndex < 0 + ifTrue: [ self argumentInlinedAt: index ] + ifFalse: [ self argumentInEnvironmentAt: index ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +argumentCount + ^activeScript argumentCount +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +argumentInEnvironmentAt: index + assembler loadRwithEindex: index + SClosure instSize +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +argumentInStackAt: index + | args end | + args := self argumentCount. + method hasFrame ifTrue: [ + end := 3 + args. + assembler loadRwithFPindex: end - index ] ifFalse: [ + end := 2 + args. + assembler loadRwithSPindex: end - index + ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +argumentInlinedAt: index + self temporaryInStackAt: index +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +associationValueAt: anInteger + | literal | + literal := self methodLiteralAt: anInteger. + assembler + loadRwithLiteral: literal; + loadRwithRindex: 2 +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +associationValueAt: anInteger put: dummy + | literal | + literal := self methodLiteralAt: anInteger. + assembler + loadAwithLiteral: literal; + storeRinAindex: 2; + pushA. + self emitWriteBarrier +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureClosure: anSBlock + | slot variables | + self instantiateClosure: anSBlock. + slot := 3. + variables := anSBlock capturedVariables readStream. + [ variables atEnd ] + whileFalse: [ self captureVariable: variables index: slot. + slot := slot + 1 ]. + anSBlock capturesHome + ifTrue: [ self emitSend: #saveHomeFrame ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureVariable: stream index: anInteger + | type pos | + type := stream next. + type = nil ifTrue: [^self]. + type = Self ifTrue: [^assembler storeSinRindex: anInteger]. + type = Environment ifTrue: [^assembler storeEinRindex: anInteger]. + pos := stream next. + type = LocalArgument ifTrue: [ + assembler + loadTwithFPindex: pos + 2; + storeTinRindex: anInteger]. + type = EnvironmentValue + ifTrue: [assembler loadTwithEindex: pos; storeTinRindex: anInteger] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +constPoolValueAt: anInteger + | literal | + literal := self methodLiteralAt: anInteger. + assembler loadRwithLiteral: literal +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +dropTos + assembler dropTos: 1. + ^stackCount := stackCount - 1 +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitBlockPrologue: anSBlock + assembler saveCallerFrame. + self + loadBlockSelf: anSBlock compiledCode; + loadBlockNativeCode; + pushNativeCode; + pushEnvironments; + initializeTemporaries: anSBlock tempCount +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitCallbackEpilogue + assembler restoreCallerFrame. + environment abi + restoreContext: method descriptor with: assembler +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitCallbackPrologue + | retaddr | + environment abi emitEntrypoint: method descriptor with: ir. + retaddr := 0. + assembler + pushImm: retaddr; + xorFPwithFP; + loadLongMwithIPoffset: 0 - assembler currentAddress + ImageSegmentWriter behaviorOffset; + loadMwithMindex: SCallbackMethod behaviorNativeCodeSlot; + loadGwithLiteral: environment globals; + loadNilWithLiteral: nil; + loadTrueWithLiteral: true; + loadFalseWithLiteral: false; + loadEwithNil; + loadRwithMindex: (NativeCode indexOfSlot: 'compiledCode'); + loadRwithRindex: (SCallbackMethod indexOfSlot: 'receiver') +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitEpilogue + method hasBlocks + ifTrue: [ assembler restoreCallerEnvironment ]. + method isCallback + ifTrue: [ ^ self emitCallbackEpilogue ]. + method isFrameless + ifFalse: [ assembler restoreCallerFrame ]. + assembler + restoreCallerSelf; + restoreCallerM; + return +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitFFICall + self loadObject: method. + assembler pushR; pushS. + self emitSend: #_ffiCall:. + assembler + restoreCallerFrame; + restoreCallerSelf; + restoreCallerM; + return +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitFallbacks + fallbacks do: [:block | block value] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitFramedMethodPrologue + assembler + saveCallerFrame; + pushR; + initializeS. + method isCalloutMethod + ifTrue: [ self emitFFICall ] + ifFalse: [ self + pushNativeCode; + initializeMethodEnvironment; + initializeMethodTemporaries; + emitSafepointCheck ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitFramelessMethodPrologue + method capturesSelf + ifTrue: [ assembler initializeS ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitMethodPrologue + method isCallback + ifTrue: [ ^self + emitCallbackPrologue; + emitFramedMethodPrologue ]. + method isFrameless + ifTrue: [ self emitFramelessMethodPrologue ] + ifFalse: [ self emitFramedMethodPrologue ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitSafepointCheck + +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitSend: selector + | linker | + linker := environment messageLinker. + method isDebuggable + ifTrue: [ linker emitSendDebuggable: selector using: assembler ] + ifFalse: [ linker emitSend: selector using: assembler ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitSend: selector super: aBoolean + | linker | + linker := environment messageLinker. + + method isDebuggable + ifTrue: [ aBoolean ifTrue: [linker emitSendSuperDebuggable: selector from: method classBinding using: ir] ifFalse: [linker emitSendDebuggable: selector using: assembler ]] + ifFalse: [ aBoolean ifTrue: [linker emitSendSuper: selector from: method classBinding using: assembler ] ifFalse: [linker emitSend: selector using: assembler ]] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +emitWriteBarrier + assembler + loadAwithGlobal: #WriteBarrier; + callIndirectA; + discardArguments: 1 +! ! + +!TemplateJIT methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environment: aNativizationEnvironment + environment := aNativizationEnvironment. + assembler := environment newAssembler +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +falseLiteral + assembler loadRwithFalse +! ! + +!TemplateJIT methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeMethodEnvironment + method hasBlocks + ifFalse: [ ^ self ]. + assembler pushE. + method hasEnvironment + ifTrue: [ assembler + pushSmallInteger: method environmentCount; + loadRwithM. + self emitSend: #newEnvironment:. + assembler + loadEwithR; + pushE ] + ifFalse: [ assembler pushNil ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeMethodTemporaries + self initializeTemporaries: method tempCount +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeTemporaries: count + count = 0 + ifTrue: [ ^ self ]. + count <= 6 + ifTrue: [ count timesRepeat: [ assembler pushNil ] ] + ifFalse: [ assembler + loop: [ assembler pushNil ] times: count ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +instanceVarAt: index + assembler loadRwithSindex: index +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +instanceVarAt: index put: value + assembler storeRinSindex: index; pushS. + self emitWriteBarrier +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +instantiateClosure: anSBlock + self loadLiteralAt: anSBlock index; emitSend: #newClosure +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithArgument: index in: envIndex + envIndex + ifNil: [ ^ self loadAwithArgumentInStackAt: index ]. envIndex < 0 + ifTrue: [ self loadAwithArgumentInlinedAt: index ] + ifFalse: [ self loadAwithArgumentInEnvironment: envIndex at: index ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithArgumentInEnvironment: envIndex at: index + | offset | + envIndex = 0 + ifTrue: [ assembler loadAwithEindex: index + SClosure instSize ] + ifFalse: [ offset := activeScript offsetOfEnvironment: envIndex. + assembler + loadAwithEindex: envIndex + SClosure instSize; + loadAwithAindex: index + offset ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithArgumentInStackAt: index + | end | + end := 3 + self argumentCount. + assembler loadAwithFPindex: end - index + +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithArgumentInlinedAt: index + self loadAwithTemporaryInStackAt: index + +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithStack: anInteger + assembler loadAwithFPindex: 1 - anInteger +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithTemporary: index in: envIndex + + envIndex + ifNil: [ self loadAwithTemporaryInStackAt: index ] + ifNotNil: [ + self loadAwithTemporaryInEnvironment: envIndex at: index ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithTemporaryInEnvironment: envIndex at: index + | offset | + envIndex = 0 + ifTrue: [offset := activeScript offsetOfCurrentEnvironment. assembler loadAwithEindex: index + offset ] + ifFalse: [ offset := activeScript offsetOfEnvironment: envIndex. + assembler + loadAwithEindex: envIndex + SClosure instSize; + loadAwithAindex: index + offset ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadAwithTemporaryInStackAt: index + | start | + start := self pushesEnvironments + ifTrue: [ -3 ] + ifFalse: [ -1 ]. + ^ assembler loadAwithFPindex: start - index + +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadBlockNativeCode + | block nativeCode | + block := SClosure indexOfSlot: 'block'. + nativeCode := SCompiledBlock indexOfSlot: 'nativeCode'. + assembler + loadMwithRindex: block; + loadMwithMindex: nativeCode +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadBlockSelf: aCompiledBlock + | offset | + aCompiledBlock capturesSelf + ifTrue: [ offset := aCompiledBlock capturesHome + ifTrue: [ 1 ] + ifFalse: [ 0 ]. + assembler loadSwithRindex: SClosure instSize + 1 + offset ] + ifFalse: [ assembler loadSwithNil ]. + assembler pushS +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadLiteralAt: anInteger + | literal | + literal := self methodLiteralAt: anInteger. + assembler loadRwithLiteral: literal +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadObject: anObject + assembler loadRwithLiteral: anObject +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadRwithStack: anInteger + assembler loadRwithFPindex: 1 - anInteger +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadTwithStack: anInteger + assembler loadTwithFPindex: 1 - anInteger +! ! + +!TemplateJIT methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +method + ^method +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodLiteralAt: anInteger + ^ method at: anInteger + +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodLiteralFrom: anInteger + ^ method at: anInteger +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativeCode + ^mainCode +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativize + method sexpressions acceptVisitor: self. + [remainingBlocks isEmpty] + whileFalse: [self nativizeBlock: remainingBlocks removeFirst] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativize: aCompiledMethod + self + resetFor: aCompiledMethod; + nativize. + ^ aCompiledMethod optimizedCode: mainCode +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativizeBlock: anSBlock + | statements | + self resetForBlock: anSBlock. + activeScript := anSBlock. + self emitBlockPrologue: anSBlock. + statements := anSBlock statements. + statements do: [:s | s acceptVisitor: self]. + self saveContextSwitchPoint. + (statements isEmpty orNot: [statements last isReturn]) + ifTrue: [self emitEpilogue]. + self emitFallbacks. + anSBlock compiledCode nativeCode: assembler applyFixups nativeCode +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +nilLiteral + assembler loadRwithNil +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +popR + assembler popR. + stackCount := stackCount - 1 +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushEnvironments + assembler pushE; loadEwithR; pushE +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushNativeCode + assembler pushM +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushR + assembler pushR. + ^stackCount := stackCount + 1 +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +pushesEnvironments + ^method hasBlocks +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +receiver + assembler loadRwithS +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +resetFor: aCompiledMethod + | fixed | + method := aCompiledMethod. + fallbacks := OrderedCollection new. + remainingBlocks := OrderedCollection new. + fixed := aCompiledMethod hasBlocks ifTrue: [4] ifFalse: [2]. + stackCount := aCompiledMethod tempCount + fixed. + assembler reset +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +resetForBlock: anSBlock + fallbacks := OrderedCollection new. + stackCount := anSBlock tempCount + 4. + assembler reset +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +saveContextSwitchPoint + method isDebuggable + ifFalse: [ ^ self ]. + assembler + pushA; + pushT; + pushR. + environment messageLinker emitSend: #signalStep using: ir. + assembler + popR; + popT; + popA +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +saveMethodCode + mainCode := assembler + applyFixups; + nativeCode +! ! + +!TemplateJIT methodsFor: 'templates' stamp: 'KenD 28/Jun/2026 13:27:40'! +sendMustBeBoolean + self emitSend: #mustBeBoolean +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +storeRInStack: index + assembler storeRinFPindex: 1 - index +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaryAt: index in: envIndex + envIndex ifNil: [ self temporaryInStackAt: index ] +ifNotNil: [ self temporaryInEnvironment: envIndex at: index ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaryAt: index in: envIndex put: dummy + envIndex ifNil: [self temporaryInStackAtPut: index ] ifNotNil: [ + self temporaryInEnvironment: envIndex atPut: index] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaryInEnvironment: envIndex at: index + | offset | + envIndex = 0 + ifTrue: [offset := activeScript offsetOfCurrentEnvironment. assembler loadRwithEindex: index + offset ] + ifFalse: [ + offset := activeScript offsetOfEnvironment: envIndex. + assembler + loadRwithEindex: envIndex + SClosure instSize ; + loadRwithRindex: index + offset] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaryInEnvironment: envIndex atPut: index + | offset | + envIndex = 0 + ifTrue: [ offset := activeScript offsetOfCurrentEnvironment. + assembler + storeRinEindex: index + offset; + pushE ] + ifFalse: [ offset := activeScript offsetOfEnvironment: envIndex. + assembler + loadTwithEindex: envIndex + SClosure instSize ; + storeRinTindex: index + offset; + pushT ]. + self emitWriteBarrier +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaryInStackAt: index + | start | + start := self pushesEnvironments + ifTrue: [ -3 ] + ifFalse: [ -1 ]. + ^ assembler loadRwithFPindex: start - index . + +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaryInStackAtPut: index + | start | + start := self pushesEnvironments + ifTrue: [ -3 ] + ifFalse: [ -1 ]. + assembler storeRinFPindex: start - index + +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +trueLiteral + assembler loadRwithTrue +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitAssignment: anSAssignment + anSAssignment expression acceptVisitor: self. + anSAssignment assignees do: [ :a | + a binding assign: nil within: self ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBlock: anSBlock + anSBlock isInlined + ifTrue: [ ^ anSBlock statements do: [ :s | s acceptVisitor: self ] ]. + remainingBlocks add: anSBlock. + self captureClosure: anSBlock +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascade: anSCascade + | receiver index | + receiver := anSCascade receiver. + receiver acceptVisitor: self. + index := self pushR. + anSCascade messages + do: [ :m | self visitCascadeMessage: m receiver: index super: receiver isSuper ]. + self dropTos +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascadeMessage: anSCascadeMessage receiver: index super: aBoolean + | arguments | + arguments := anSCascadeMessage arguments. + arguments + do: [ :node | + node acceptVisitor: self. + self pushR ]. + self + loadRwithStack: index; + emitSend: anSCascadeMessage selector super: aBoolean. + stackCount := stackCount - arguments size +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitIdentifier: anSIdentifier + anSIdentifier binding valueWithin: self +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitInlinedMessage: anSMessage + | nativizer | + nativizer := InlinedMessageNativizer new + message: anSMessage; + assembler: ir; + nativizer: self. + nativizer inlineMessage +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitLiteral: anSLiteral + | value | + value := anSLiteral value. + value isSmallInteger + ifTrue: [ assembler loadRwithSmallInteger: value ] + ifFalse: [ self loadLiteralAt: anSLiteral index ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMessage: anSMessage + | arguments index | + anSMessage isInlined + ifTrue: [ ^ self visitInlinedMessage: anSMessage ]. + anSMessage isOptimized + ifTrue: [ ^ self visitOptimizedMessage: anSMessage ]. + anSMessage receiver acceptVisitor: self. + arguments := anSMessage arguments. + arguments isEmpty + ifFalse: [ index := self pushR. + arguments + do: [ :node | + node acceptVisitor: self. + self pushR ]. + self loadRwithStack: index ]. + self emitSend: anSMessage selector super: anSMessage receiver isSuper. + stackCount := stackCount - arguments size. + arguments isEmpty + ifFalse: [ self dropTos ] +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMethod: anSMethod + | statements returned | + activeScript := anSMethod. + self emitMethodPrologue. + statements := anSMethod statements. + statements do: [ :s | s acceptVisitor: self ]. + (statements notEmpty andNot: [ statements last isReturn ]) + ifTrue: [ assembler loadRwithS ]. + returned := statements notEmpty and: [ + statements last isReturn]. + returned ifFalse: [ self emitEpilogue ]. + self + emitFallbacks; + saveMethodCode +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitOptimizedMessage: anSMessage + | nativizer | + nativizer := BinaryMessageNativizer new + message: anSMessage; + assembler: ir; + nativizer: self. + nativizer inlineMessage +! ! + +!TemplateJIT methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitReturn: anSReturn + anSReturn expression acceptVisitor: self. + anSReturn local ifTrue: [ self emitEpilogue ] ifFalse: [ assembler + pushR; + loadRwithE. + self emitSend: #_return: ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TemplateJIT class' category: #Nativization! +TemplateJIT class + instanceVariableNames: ''! + + +TemplateJIT initialize! + diff --git a/modules/LMR/Nativizer/Tests/TemplateJIT.Class.st b/modules/LMR/Nativizer/Tests/TemplateJIT.Class.st new file mode 100644 index 00000000..30d6eadd --- /dev/null +++ b/modules/LMR/Nativizer/Tests/TemplateJIT.Class.st @@ -0,0 +1,154 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TemplateJIT category: #'Nativization-Tests'! +Object subclass: #TemplateJIT + instanceVariableNames: 'environment' + classVariableNames: '' + poolDictionaries: '' + category: 'Nativization-Tests'! +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +nativize: aCompiledMethod + ^ NativizationEnvironment forTesting newTemplateJIT + nativize: aCompiledMethod +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyFor: aCompiledMethod + ^ NativizationEnvironment forTesting + newTemplateJIT nativize: aCompiledMethod +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForBlock + ^self assemblyForSource: 'foo [1] value' +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForIfTrue + ^self assemblyForSource: 'foo x ifTrue: [1]' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForMessage + ^self assemblyForSource: 'foo self bar' +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForMessageCascade + ^self assemblyForSource: 'foo self bar; baz' +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForMethod: aCompiledMethod + +^ self + assemblyForSource: aCompiledMethod sourceCode + in: aCompiledMethod classBinding value. + +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForPoint_1_plus_y + ^self assemblyForSource: 'foo 1 + y' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForPoint_ret_x_eq_1 + ^ self assemblyForSource: 'foo ^x = 1' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForPoint_x + ^ self assemblyForMethod: Point >> #x +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForPoint_x_eq_1 + ^self assemblyForSource: 'foo x = 1' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForPoint_x_eq_eq_1 + ^self assemblyForSource: 'foo x == 1' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForPoint_x_plus_1 + ^self assemblyForSource: 'foo x + 1' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForPoint_x_plus_y + ^self assemblyForSource: 'foo x + y' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForSource: aString + ^self assemblyForSource: aString in: UndefinedObject +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForSource: aString in: aSpecies + | method | + method := SCompiler compile: aString in: aSpecies. + ^self assemblyFor: method +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForSourceOrig: aString + ^self assemblyForSourceOrig: aString in: UndefinedObject +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForSourceOrig: aString in: aSpecies + | method | + method := SCompiler compile: aString in: aSpecies. + ^self assemblyOrigFor: method +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyForWhileTrue + ^self assemblyForSource: 'foo [x := x + 1. true] whileTrue' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +assemblyOrigFor: aCompiledMethod + ^ NativizationEnvironment forTesting nativize: + aCompiledMethod +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodBasicAdd + | source | + source := 'basicAdd: anObject + end = contents size ifTrue: [self makeRoomBehind]. + end := end + 1. + contents at: end put: anObject. + ^anObject'. + ^self methodForSource: source in: OrderedCollection +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodForSource: aString + ^self methodForSource: aString in: UndefinedObject +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodForSource: aString in: aSpecies + | method | + method := SCompiler compile: aString in: aSpecies. + ^self nativize: method +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodWithBlock + ^self methodForSource: 'foo [1] value' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TemplateJIT class' category: #'Nativization-Tests'! +TemplateJIT class + instanceVariableNames: ''! + + diff --git a/modules/LMR/NonMovingCollector.Class.st b/modules/LMR/NonMovingCollector.Class.st new file mode 100644 index 00000000..39133a1b --- /dev/null +++ b/modules/LMR/NonMovingCollector.Class.st @@ -0,0 +1,254 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #NonMovingCollector category: #Kernel! +GarbageCollector subclass: #NonMovingCollector + instanceVariableNames: 'stack limit index scanned largeSize' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!NonMovingCollector commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +checkReachablePropertyOf: ephemeron + | key | + key := ephemeron _basicAt: 1. + ^key _isSmallInteger or: [key _hasBeenSeen] +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyOf: object + self error: 'non-moving collector should not copy' +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyRescuedEphemerons + rescuedEphemerons := memory oldSpace + shallowCopyCommiting: rescuedEphemerons. + ^memory oldSpace shallowCopyCommiting: rescuedEphemerons contents +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +doCollect + super doCollect. + self purgeRememberedSet +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +evacuate: object + ^self error: 'non-moving collector should not evacuate' +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +followClosure + [stack notEmpty or: [stacks notEmpty]] + whileTrue: [self followObjects; scanStacks] +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +followObjects + [stack isEmpty] whileFalse: [ + limit := stack pop. + index := stack pop. + scanned := stack pop. + [index <= limit] + whileTrue: [index = 0 + ifTrue: [self scanBehavior] + ifFalse: [self scanSlot]]] +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasToEvacuate: anObject + ^false +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialContainerCapacity + ^self workSpaceSize // 1000 +! ! + +!NonMovingCollector methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeLocals + stack := CriticalStack emptyReserving: 64 kbytes. + largeSize := memory largeSpaces size. + memory old resetOccupancy. + super initializeLocals +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +purgeRememberedSet + | object kept rs | + rs := memory rememberedSet. + kept := 0. + 1 to: rs size do: [:i | + object := rs at: i. + object _hasBeenSeen ifTrue: [ + (self hasToEvacuate: object) ifTrue: [object := self copyOf: object]. + kept := kept + 1. + rs at: kept put: object]]. + rs size: kept +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +queue: anObject from: start to: end + stack + push: anObject; + push: start; + push: end +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +queueCurrent + stack + push: scanned; + push: index + 1; + push: limit +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +releaseLocals + self sweepLargeSpaces. + stack release. + stack := scanned := nil. + super releaseLocals +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scan: anObject from: start to: end + stack + push: anObject; + push: start; + push: end +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanBehavior + | slot evacuate | + slot := scanned _longSlotAt: 0. + slot _isSmallInteger ifTrue: [^index := index + 1]. + evacuate := self hasToEvacuate: slot. + slot _hasBeenSeen ifTrue: [ + evacuate ifTrue: [ + slot := self copyOf: slot. + scanned _longSlotAt: 0 put: slot]. + ^index := index + 1]. + slot _beSeen. + evacuate + ifTrue: [ + slot := self evacuate: slot. + scanned _longSlotAt: 0 put: slot] + ifFalse: [self updateRegionOccupancy: slot]. + slot _isSpecial ifTrue: [self rememberSpecial: slot]. + index < limit ifTrue: [self queueCurrent]. + index := 0. + limit := slot _strongPointersSize. + scanned := slot +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanSlot + | slot evacuate | + slot := scanned _basicAt: index. + slot _isSmallInteger ifTrue: [^index := index + 1]. + evacuate := self hasToEvacuate: slot. + slot _hasBeenSeen ifTrue: [ + evacuate ifTrue: [ + slot := self copyOf: slot. + scanned _basicAt: index put: slot]. + ^index := index + 1]. + slot _beSeen. + evacuate + ifTrue: [ + slot := self evacuate: slot. + scanned _basicAt: index put: slot] + ifFalse: [self updateRegionOccupancy: slot]. + slot _isSpecial ifTrue: [self rememberSpecial: slot]. + index < limit ifTrue: [self queueCurrent]. + index := 0. + limit := slot _strongPointersSize. + scanned := slot +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanThreadLocalStorage: thread + thread localStorageIndices + do: [:i | self scanThreadLocalStorage: thread at: i] +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanThreadLocalStorage: thread at: i + | slot evacuate | + slot := thread tlsAt: i. + slot _isSmallInteger ifTrue: [^self]. + evacuate := self hasToEvacuate: slot. + slot _hasBeenSeen ifTrue: [ + ^evacuate ifTrue: [ + slot := self copyOf: slot. + thread tlsAt: i put: slot]]. + slot _beSeen. + evacuate + ifTrue: [ + slot := self evacuate: slot. + thread tlsAt: i put: slot] + ifFalse: [self updateRegionOccupancy: slot]. + slot _isSpecial ifTrue: [self rememberSpecial: slot]. + self queue: slot from: 0 to: slot _strongPointersSize +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +scanTopSlot: stackWrapper + self queue: stackWrapper sp _asObject from: 1 to: 1 +! ! + +!NonMovingCollector methodsFor: 'ephemerons' stamp: 'KenD 28/Jun/2026 13:27:39'! +sweepLargeSpaces + | used large registered | + used := 0. + large := memory largeSpaces. + registered := memory spaces. + 1 to: largeSize do: [:i | | s | + s := large at: i. + s firstObject _hasBeenSeen + ifTrue: [ + used := used + 1. + large at: used put: s] + ifFalse: [ + Kernel os release: s base * 2. + registered remove: s]]. + largeSize + 1 to: large size do: [:i | | s | + s := large at: i. + used := used + 1. + large at: used put: s]. + used + 1 to: large size do: [:i | large at: i put: nil]. + large size: used +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateRegionOccupancy: object + memory old updateRegionOccupancy: object +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +updateWeak: weakContainer at: i + | object | + object := weakContainer _basicAt: i. + object _isSmallInteger ifTrue: [^self]. + object _hasBeenSeen ifTrue: [^self]. + weakContainer _basicAt: i put: tombstone +! ! + +!NonMovingCollector methodsFor: 'cleaning' stamp: 'KenD 28/Jun/2026 13:27:39'! +workSpaceSize + ^20 mbytes +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NonMovingCollector class' category: #Kernel! +NonMovingCollector class + instanceVariableNames: ''! + + diff --git a/modules/LMR/PinnedAllocator.Class.st b/modules/LMR/PinnedAllocator.Class.st new file mode 100644 index 00000000..06a7f00b --- /dev/null +++ b/modules/LMR/PinnedAllocator.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PinnedAllocator category: #Kernel! +Allocator subclass: #PinnedAllocator + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!PinnedAllocator commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!PinnedAllocator methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:39'! +allocate: anInteger + ^memory pinnedAllocate: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PinnedAllocator class' category: #Kernel! +PinnedAllocator class + instanceVariableNames: ''! + + diff --git a/modules/LMR/ReifiedStackFrameCursor.Class.st b/modules/LMR/ReifiedStackFrameCursor.Class.st new file mode 100644 index 00000000..3d3c0b39 --- /dev/null +++ b/modules/LMR/ReifiedStackFrameCursor.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ReifiedStackFrameCursor category: #Kernel! +StackFrameCursor subclass: #ReifiedStackFrameCursor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!ReifiedStackFrameCursor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ReifiedStackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addObjectsTo: aCollection + self slotCount to: 1 by: -1 do: [:i | aCollection add: (self slotAt: i)] +! ! + +!ReifiedStackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +caller + ^current + ((current _asObject _basicAt: 1) // 2) +! ! + +!ReifiedStackFrameCursor methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +ended + ^current == previous +! ! + +!ReifiedStackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectsDo: aBlock + self slotCount to: 1 by: -1 do: [:i | aBlock value: (self slotAt: i)] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ReifiedStackFrameCursor class' category: #Kernel! +ReifiedStackFrameCursor class + instanceVariableNames: ''! + + diff --git a/modules/LMR/RememberedSet.Class.st b/modules/LMR/RememberedSet.Class.st new file mode 100644 index 00000000..e5db3b05 --- /dev/null +++ b/modules/LMR/RememberedSet.Class.st @@ -0,0 +1,103 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #RememberedSet category: #Kernel! +Object subclass: #RememberedSet + instanceVariableNames: 'base tally maxSize' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!RememberedSet commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +add: anObject + " + We first check if grow is needed, then increment the tally and + finally grow. If not done this way, if growing adds something to + the remembered set it could cause an infinite recursion + " + | grow | + grow := tally + 10 = maxSize. + tally := tally + 1. + base _asObject _basicAt: tally put: anObject. + grow ifTrue: [self grow: maxSize * 2] +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: anInteger + ^base _asObject _basicAt: anInteger +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: anInteger put: anObject + ^base _asObject _basicAt: anInteger put: anObject +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +base + ^base +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +base: anInteger + base := anInteger +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +grow: anInteger + | new old | + new := (Kernel os reserveAndCommit: anInteger * WordSize) // 2. + 1 + to: tally + do: [:i | new _asObject _basicAt: i put: (base _asObject _basicAt: i)]. + old := base. + base := new. + maxSize := anInteger. + Kernel os release: old * 2 +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +includesIdentical: anObject + 1 to: maxSize do: [:i | anObject == (self at: i) ifTrue: [^true]]. + ^false +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize: anInteger + tally := 0. + base := (Kernel os reserveAndCommit: anInteger * WordSize) // 2. + maxSize := anInteger +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +maxSize + ^maxSize +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +release + Kernel os release: base * 2. + base := nil. + tally := maxSize := 0 +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +size + ^tally +! ! + +!RememberedSet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +size: anInteger + tally := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RememberedSet class' category: #Kernel! +RememberedSet class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/CompiledMethod.Extension.st b/modules/LMR/SExpressions/CompiledMethod.Extension.st new file mode 100644 index 00000000..49e021a4 --- /dev/null +++ b/modules/LMR/SExpressions/CompiledMethod.Extension.st @@ -0,0 +1,13 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!CompiledMethod methodsFor: '*Compiling' stamp: 'KenD 28/Jun/2026 13:27:39'! +sexpressions + | decoder | + decoder := TreecodeDecoder new + stream: treecodes readStream; + method: self. + ^decoder decodeMethod +! ! + + diff --git a/modules/LMR/SExpressions/SArgumentBinding.Class.st b/modules/LMR/SExpressions/SArgumentBinding.Class.st new file mode 100644 index 00000000..0a1ca7c9 --- /dev/null +++ b/modules/LMR/SExpressions/SArgumentBinding.Class.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SArgumentBinding category: 'Powerlang-Core-SExpressions'! +SLocalBinding subclass: #SArgumentBinding + instanceVariableNames: 'inlined' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +assign: value within: anEvaluationContext + self halt +! ! + +!SArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isArgument + ^true +! ! + +!SArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInlined + ^ environment = -1 +! ! + +!SArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream + nextPutAll: 'SArgument '; + print: position; + nextPutAll: ' @ env '; + print: environment +! ! + +!SArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext + ^ anEvaluationContext argumentAt: position in: environment +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SArgumentBinding class' category: 'Powerlang-Core-SExpressions'! +SArgumentBinding class + instanceVariableNames: ''! + +!SArgumentBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeArgument +! ! + + diff --git a/modules/LMR/SExpressions/SAssignment.Class.st b/modules/LMR/SExpressions/SAssignment.Class.st new file mode 100644 index 00000000..2c9905cc --- /dev/null +++ b/modules/LMR/SExpressions/SAssignment.Class.st @@ -0,0 +1,78 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SAssignment category: 'Powerlang-Core-SExpressions'! +SExpression subclass: #SAssignment + instanceVariableNames: 'assignees expression' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SAssignment methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^visitor visitAssignment: self +! ! + +!SAssignment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +assign: anSIdentifier + assignees add: anSIdentifier +! ! + +!SAssignment methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +assignees + ^assignees +! ! + +!SAssignment methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +expression + ^expression +! ! + +!SAssignment methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +expression: anSExpression + expression := anSExpression +! ! + +!SAssignment methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + assignees := OrderedCollection new +! ! + +!SAssignment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isAssignment + ^true +! ! + +!SAssignment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream indent: anInteger + aStream tab: anInteger; nextPutAll: '{AssignmentId.'. + assignees + do: [:identifier | + aStream cr. + identifier printOn: aStream indent: anInteger + 1] + separatedBy: [aStream nextPutAll: '.']. + aStream nextPutAll: '.'; cr. + expression printOn: aStream indent: anInteger + 1. + aStream nextPutAll: '}' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SAssignment class' category: 'Powerlang-Core-SExpressions'! +SAssignment class + instanceVariableNames: ''! + +!SAssignment class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeAssignment +! ! + +!SAssignment class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + "return an initialized instance" + + ^ self basicNew initialize. + +! ! + + +SAssignment initialize! + diff --git a/modules/LMR/SExpressions/SAssociationBinding.Class.st b/modules/LMR/SExpressions/SAssociationBinding.Class.st new file mode 100644 index 00000000..82f11d5f --- /dev/null +++ b/modules/LMR/SExpressions/SAssociationBinding.Class.st @@ -0,0 +1,55 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SAssociationBinding category: 'Powerlang-Core-SExpressions'! +SBinding subclass: #SAssociationBinding + instanceVariableNames: 'index association' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +assign: value within: anEvaluationContext + anEvaluationContext storeAssociation: association value: value +! ! + +!SAssociationBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +association + ^association +! ! + +!SAssociationBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +association: anAssociation + association := anAssociation +! ! + +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index + ^ index +! ! + +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index: anInteger + index := anInteger +! ! + +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isAssociation + ^true +! ! + +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isConstant + ^ false +! ! + +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext + ^ anEvaluationContext loadAssociationValue: association +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SAssociationBinding class' category: 'Powerlang-Core-SExpressions'! +SAssociationBinding class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SBinding.Class.st b/modules/LMR/SExpressions/SBinding.Class.st new file mode 100644 index 00000000..54026320 --- /dev/null +++ b/modules/LMR/SExpressions/SBinding.Class.st @@ -0,0 +1,101 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SBinding category: 'Powerlang-Core-SExpressions'! +Object subclass: #SBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +assign: value within: anEggRuntime + ^ self subclassResponsibility +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +assign: value within: anEvaluationContext ifUnbound: aClosure + ^self assign: value within: anEvaluationContext + +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isArgument + ^false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isAssociation + ^false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isClassBinding + ^false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isClassVar + ^false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isDynamic + ^ false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInstVar + ^false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isLiteral + ^false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPoolVar + ^false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSelf + ^false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSuper + ^false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isTemporary + ^false +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^self printString +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext + ^ self subclassResponsibility +! ! + +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext ifUnbound: aClosure + ^self valueWithin: anEvaluationContext +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SBinding class' category: 'Powerlang-Core-SExpressions'! +SBinding class + instanceVariableNames: ''! + +!SBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^self subclassResponsibility +! ! + + diff --git a/modules/LMR/SExpressions/SBlock.Class.st b/modules/LMR/SExpressions/SBlock.Class.st new file mode 100644 index 00000000..f5c16fa6 --- /dev/null +++ b/modules/LMR/SExpressions/SBlock.Class.st @@ -0,0 +1,98 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SBlock category: 'Powerlang-Core-SExpressions'! +SScript subclass: #SBlock + instanceVariableNames: 'index capturedVariables inlinedArgs' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SBlock methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^visitor visitBlock: self +! ! + +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +capturedVariables + ^capturedVariables +! ! + +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +capturedVariables: aCollection + capturedVariables := aCollection +! ! + +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +capturesHome + ^compiledCode capturesHome +! ! + +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index + ^index +! ! + +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index: anInteger + index := anInteger +! ! + +!SBlock methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + capturedVariables := #() +! ! + +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlinedArgs + ^ inlinedArgs +! ! + +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlinedArgs: anArray + inlinedArgs:= anArray +! ! + +!SBlock methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +isBlock + ^true +! ! + +!SBlock methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInlined + ^ compiledCode isNil +! ! + +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +offsetOfCurrentEnvironment + ^ 2 +! ! + +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +optimizedCode + ^compiledCode optimizedCode +! ! + +!SBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream indent: anInteger + aStream + tab: anInteger; + nextPutAll: '{BlockId. capturedVariables: '; + print: capturedVariables; + cr. + super printOn: aStream indent: anInteger. + aStream nextPutAll: '}' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SBlock class' category: 'Powerlang-Core-SExpressions'! +SBlock class + instanceVariableNames: ''! + +!SBlock class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeBlock +! ! + + +SBlock initialize! + diff --git a/modules/LMR/SExpressions/SCascade.Class.st b/modules/LMR/SExpressions/SCascade.Class.st new file mode 100644 index 00000000..23e9436e --- /dev/null +++ b/modules/LMR/SExpressions/SCascade.Class.st @@ -0,0 +1,50 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SCascade category: 'Powerlang-Core-SExpressions'! +SExpression subclass: #SCascade + instanceVariableNames: 'receiver messages' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SCascade methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^visitor visitCascade: self +! ! + +!SCascade methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isCascade + ^true +! ! + +!SCascade methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +messages + ^messages +! ! + +!SCascade methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +messages: aCollection + messages := aCollection +! ! + +!SCascade methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver + ^receiver +! ! + +!SCascade methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver: anSExpression + receiver := anSExpression +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SCascade class' category: 'Powerlang-Core-SExpressions'! +SCascade class + instanceVariableNames: ''! + +!SCascade class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeCascade +! ! + + diff --git a/modules/LMR/SExpressions/SCascadeMessage.Class.st b/modules/LMR/SExpressions/SCascadeMessage.Class.st new file mode 100644 index 00000000..732c3cf3 --- /dev/null +++ b/modules/LMR/SExpressions/SCascadeMessage.Class.st @@ -0,0 +1,108 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SCascadeMessage category: 'Powerlang-Core-SExpressions'! +SExpression subclass: #SCascadeMessage + instanceVariableNames: 'selector arguments cascade cache' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitCascadeMessage: self +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +argumentCount + ^arguments size +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +arguments + ^arguments +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +arguments: aCollection + arguments := aCollection +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cache: anSCompiledMethod when: type + cache ifNil: [ ^ cache := Array with: type with: anSCompiledMethod ]. + cache := cache , (Array with: type with: anSCompiledMethod) +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cacheUndermessage: aBlockClosure + cache := aBlockClosure +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cachedUndermessage + ^ cache isBlock + ifTrue: [ cache ] +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cascade + cascade +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cascade: anSCascade + cascade := anSCascade +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +flushCache + cache := nil +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isCascadeMessage + ^true +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +methodFor: requiredType + | type | + cache ifNil: [ ^ nil ]. + 1 to: cache size by: 2 do: [ :i | + type := cache at: i. + type == requiredType + ifTrue: [ ^ cache at: i + 1 ] ]. + ^ nil +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver + ^cascade receiver +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +registerCacheWith: runtime + cache ifNil: [ runtime registerCache: self for: selector ] +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector + ^selector +! ! + +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector: aSymbol + selector := aSymbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SCascadeMessage class' category: 'Powerlang-Core-SExpressions'! +SCascadeMessage class + instanceVariableNames: ''! + +!SCascadeMessage class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeCascadeMessage +! ! + + diff --git a/modules/LMR/SExpressions/SDynamicBinding.Class.st b/modules/LMR/SExpressions/SDynamicBinding.Class.st new file mode 100644 index 00000000..2f74cda9 --- /dev/null +++ b/modules/LMR/SExpressions/SDynamicBinding.Class.st @@ -0,0 +1,63 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SDynamicBinding category: 'Powerlang-Core-SExpressions'! +SBinding subclass: #SDynamicBinding + instanceVariableNames: 'name cache' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +assign: value within: anEvaluationContext ifUnbound: aClosure + + cache ifNil: [ self lookupWithin: anEvaluationContext ]. + cache ifNil: [ ^ aClosure value ]. + cache assign: value within: anEvaluationContext +! ! + +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isDynamic + ^true +! ! + +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupWithin: anEvaluationContext + cache := anEvaluationContext staticBindingFor: name +! ! + +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + name +! ! + +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aSymbol + name := aSymbol +! ! + +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream + nextPutAll: 'DinamicVarId. '; + nextPutAll: name printString +! ! + +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext ifUnbound: aClosure + + cache ifNil: [ self lookupWithin: anEvaluationContext ]. + cache ifNil: [ ^ aClosure value ]. + ^ cache valueWithin: anEvaluationContext +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SDynamicBinding class' category: 'Powerlang-Core-SExpressions'! +SDynamicBinding class + instanceVariableNames: ''! + +!SDynamicBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^ aTreecodeDecoder decodeDynamicVar +! ! + + diff --git a/modules/LMR/SExpressions/SExpression.Class.st b/modules/LMR/SExpressions/SExpression.Class.st new file mode 100644 index 00000000..72d68b45 --- /dev/null +++ b/modules/LMR/SExpressions/SExpression.Class.st @@ -0,0 +1,85 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SExpression category: 'Powerlang-Core-SExpressions'! +Object subclass: #SExpression + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SExpression commentStamp: '' prior: 0! + +I am a Smalltalk expression, the minimal unit of Smalltalk semantics, expressed as a tree +! + +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^self subclassResponsibility +! ! + +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isAssignment + ^false +! ! + +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isCascade + ^false +! ! + +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isCascadeMessage + ^false +! ! + +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isIdentifier + ^false +! ! + +!SExpression methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInstVar + ^false +! ! + +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isLiteral + ^false +! ! + +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMessage + ^false +! ! + +!SExpression methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMethod + ^false +! ! + +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isReturn + ^false +! ! + +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSuper + ^ false +! ! + +!SExpression methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + self printOn: aStream indent: 0 +! ! + +!SExpression methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream indent: anInteger + super printOn: aStream +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SExpression class' category: 'Powerlang-Core-SExpressions'! +SExpression class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SExpressionsModule.Class.st b/modules/LMR/SExpressions/SExpressionsModule.Class.st new file mode 100644 index 00000000..f41b7aef --- /dev/null +++ b/modules/LMR/SExpressions/SExpressionsModule.Class.st @@ -0,0 +1,27 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SExpressionsModule category: #'Powerlang-Core-LMR'! +Module subclass: #SExpressionsModule + instanceVariableNames: 'globals memory' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-LMR'! +!SExpressionsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + } +! ! + +!SExpressionsModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +justLoaded + super justLoaded. + TreecodeDecoder initializePools; initializeBindingTypes; initializeNodeTypes +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SExpressionsModule class' category: #'Powerlang-Core-LMR'! +SExpressionsModule class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SFalseBinding.Class.st b/modules/LMR/SExpressions/SFalseBinding.Class.st new file mode 100644 index 00000000..e675caef --- /dev/null +++ b/modules/LMR/SExpressions/SFalseBinding.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SFalseBinding category: 'Powerlang-Core-SExpressions'! +SLiteralBinding subclass: #SFalseBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SFalseBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: 'FalseId' +! ! + +!SFalseBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +value + ^false +! ! + +!SFalseBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext + ^ anEvaluationContext false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SFalseBinding class' category: 'Powerlang-Core-SExpressions'! +SFalseBinding class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SIdentifier.Class.st b/modules/LMR/SExpressions/SIdentifier.Class.st new file mode 100644 index 00000000..5f7db8c0 --- /dev/null +++ b/modules/LMR/SExpressions/SIdentifier.Class.st @@ -0,0 +1,94 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SIdentifier category: 'Powerlang-Core-SExpressions'! +SExpression subclass: #SIdentifier + instanceVariableNames: 'binding' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^visitor visitIdentifier: self +! ! + +!SIdentifier methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +binding + ^binding +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +binding: aBinding + binding := aBinding +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isArgument + ^binding isArgument +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isAssociation + ^binding isAssociation +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isIdentifier + ^true +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInstVar + ^binding isInstVar +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isLiteral + ^binding isLiteral +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSelf + ^binding isSelf +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSelfOrSuper + ^binding isSelf or: [binding isSuper] +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSuper + ^binding isSuper +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isTemporary + ^binding isTemporary +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isVariable + ^true +! ! + +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream indent: anInteger + aStream + tab: anInteger; + nextPutAll: '{IdentifierId. '; + print: binding; + nextPutAll: '}' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SIdentifier class' category: 'Powerlang-Core-SExpressions'! +SIdentifier class + instanceVariableNames: ''! + +!SIdentifier class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeIdentifier +! ! + + diff --git a/modules/LMR/SExpressions/SInlinerOperation.Class.st b/modules/LMR/SExpressions/SInlinerOperation.Class.st new file mode 100644 index 00000000..5e7a4134 --- /dev/null +++ b/modules/LMR/SExpressions/SInlinerOperation.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SInlinerOperation category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SInlinerOperation + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SInlinerOperation class' category: 'Powerlang-Core-SExpressions'! +SInlinerOperation class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SInstVarBinding.Class.st b/modules/LMR/SExpressions/SInstVarBinding.Class.st new file mode 100644 index 00000000..b117931d --- /dev/null +++ b/modules/LMR/SExpressions/SInstVarBinding.Class.st @@ -0,0 +1,50 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SInstVarBinding category: 'Powerlang-Core-SExpressions'! +SBinding subclass: #SInstVarBinding + instanceVariableNames: 'index' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SInstVarBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +assign: value within: anEvaluationContext + anEvaluationContext instanceVarAt: index put: value +! ! + +!SInstVarBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index + ^index +! ! + +!SInstVarBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index: anInteger + index := anInteger +! ! + +!SInstVarBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInstVar + ^true +! ! + +!SInstVarBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: 'InstVarId. '; nextPutAll: index printString +! ! + +!SInstVarBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext + ^ anEvaluationContext instanceVarAt: index +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SInstVarBinding class' category: 'Powerlang-Core-SExpressions'! +SInstVarBinding class + instanceVariableNames: ''! + +!SInstVarBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeInstVar +! ! + + diff --git a/modules/LMR/SExpressions/SLiteral.Class.st b/modules/LMR/SExpressions/SLiteral.Class.st new file mode 100644 index 00000000..78cbcaad --- /dev/null +++ b/modules/LMR/SExpressions/SLiteral.Class.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SLiteral category: 'Powerlang-Core-SExpressions'! +SLiteralVar subclass: #SLiteral + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SLiteral methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitLiteral: self +! ! + +!SLiteral methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isLiteral + ^true +! ! + +!SLiteral methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream indent: anInteger + aStream + tab: anInteger; + nextPutAll: '{LiteralId. '; + print: value; + nextPutAll: '}' +! ! + +!SLiteral methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +value + ^value +! ! + +!SLiteral methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +value: anObject + value := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SLiteral class' category: 'Powerlang-Core-SExpressions'! +SLiteral class + instanceVariableNames: ''! + +!SLiteral class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeLiteral +! ! + + diff --git a/modules/LMR/SExpressions/SLiteralBinding.Class.st b/modules/LMR/SExpressions/SLiteralBinding.Class.st new file mode 100644 index 00000000..a50e0031 --- /dev/null +++ b/modules/LMR/SExpressions/SLiteralBinding.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SLiteralBinding category: 'Powerlang-Core-SExpressions'! +SBinding subclass: #SLiteralBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SLiteralBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isLiteral + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SLiteralBinding class' category: 'Powerlang-Core-SExpressions'! +SLiteralBinding class + instanceVariableNames: ''! + +!SLiteralBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^self new +! ! + + diff --git a/modules/LMR/SExpressions/SLiteralVar.Class.st b/modules/LMR/SExpressions/SLiteralVar.Class.st new file mode 100644 index 00000000..1c709c5a --- /dev/null +++ b/modules/LMR/SExpressions/SLiteralVar.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SLiteralVar category: 'Powerlang-Core-SExpressions'! +SExpression subclass: #SLiteralVar + instanceVariableNames: 'index' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SLiteralVar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index + ^index +! ! + +!SLiteralVar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index: anInteger + index := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SLiteralVar class' category: 'Powerlang-Core-SExpressions'! +SLiteralVar class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SLocalBinding.Class.st b/modules/LMR/SExpressions/SLocalBinding.Class.st new file mode 100644 index 00000000..66ae2527 --- /dev/null +++ b/modules/LMR/SExpressions/SLocalBinding.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SLocalBinding category: 'Powerlang-Core-SExpressions'! +SBinding subclass: #SLocalBinding + instanceVariableNames: 'position environment' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SLocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +environment + ^environment +! ! + +!SLocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +environment: anInteger + environment := anInteger +! ! + +!SLocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index + ^position +! ! + +!SLocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index: anInteger + position := anInteger +! ! + +!SLocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInStack + self ASSERT: false. + ^ environment = 0 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SLocalBinding class' category: 'Powerlang-Core-SExpressions'! +SLocalBinding class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SMessage.Class.st b/modules/LMR/SExpressions/SMessage.Class.st new file mode 100644 index 00000000..e5088ce0 --- /dev/null +++ b/modules/LMR/SExpressions/SMessage.Class.st @@ -0,0 +1,145 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SMessage category: 'Powerlang-Core-SExpressions'! +SExpression subclass: #SMessage + instanceVariableNames: 'selector receiver arguments cache inlined' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^visitor visitMessage: self +! ! + +!SMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +argumentCount + ^arguments size +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +arguments + ^arguments +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +arguments: aCollection + arguments := aCollection +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cache: anSCompiledMethod when: type + cache + ifNil: [ ^ cache := Array with: type with: + anSCompiledMethod]. + cache := cache + , + (Array with: type with: + anSCompiledMethod) +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cacheUndermessage: aBlockClosure + cache := aBlockClosure +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cachedUndermessage + ^cache isBlock ifTrue: [ cache ] +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +flushCache + cache := nil +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + arguments := #(). + inlined := false +! ! + +!SMessage methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +inlined: aBoolean + inlined := aBoolean +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInlined + ^ inlined +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMessage + ^true +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +methodFor: requiredType + | type | + cache ifNil: [ ^ nil ]. + 1 to: cache size by: 2 do: [ :i | + type := cache at: i. + type == requiredType + ifTrue: [ ^ cache at: i + 1 ] ]. + ^ nil +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream indent: anInteger + aStream tab: anInteger; nextPutAll: '{MessageId. '; print: selector; nextPutAll: '. '; cr. + receiver printOn: aStream indent: anInteger + 1. + aStream nextPutAll: '.'; cr. + arguments + do: [:statement | statement printOn: aStream indent: anInteger + 1] + separatedBy: [aStream nextPutAll: '. '; cr]. + aStream nextPutAll: '}' +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver + ^receiver +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver: anSExpression + receiver := anSExpression +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +registerCacheWith: runtime + cache ifNil: [ runtime registerCache: self for: selector ] +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector + ^selector +! ! + +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector: aSelector + selector := aSelector +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SMessage class' category: 'Powerlang-Core-SExpressions'! +SMessage class + instanceVariableNames: ''! + +!SMessage class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeMessage +! ! + +!SMessage class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + "return an initialized instance" + + ^ self basicNew initialize. + +! ! + + +SMessage initialize! + diff --git a/modules/LMR/SExpressions/SMethod.Class.st b/modules/LMR/SExpressions/SMethod.Class.st new file mode 100644 index 00000000..7ba1557b --- /dev/null +++ b/modules/LMR/SExpressions/SMethod.Class.st @@ -0,0 +1,58 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SMethod category: 'Powerlang-Core-SExpressions'! +SScript subclass: #SMethod + instanceVariableNames: 'pragma' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SMethod methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^visitor visitMethod: self +! ! + +!SMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMethod + ^true +! ! + +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +offsetOfCurrentEnvironment + ^ 0 +! ! + +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +offsetOfEnvironment: anInteger + ^0 +! ! + +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pragma + ^pragma +! ! + +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +pragma: anSPragma + pragma := anSPragma +! ! + +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +primitive + ^pragma ifNotNil: [ pragma name ] +! ! + +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream indent: anInteger + aStream nextPutAll: '{MethodId. '; cr. + pragma ifNotNil: [ (pragma isKindOf: SExpression) ifTrue: [ pragma printOn: aStream indent: anInteger + 1] ifFalse: [ aStream tab: anInteger + 1; print: pragma ] ]. + super printOn: aStream indent: anInteger. + aStream nextPutAll: '}' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SMethod class' category: 'Powerlang-Core-SExpressions'! +SMethod class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SNestedDynamicBinding.Class.st b/modules/LMR/SExpressions/SNestedDynamicBinding.Class.st new file mode 100644 index 00000000..1950e650 --- /dev/null +++ b/modules/LMR/SExpressions/SNestedDynamicBinding.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SNestedDynamicBinding category: 'Powerlang-Core-SExpressions'! +SDynamicBinding subclass: #SNestedDynamicBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SNestedDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupWithin: anEvaluationContext + cache := anEvaluationContext staticBindingForNested: name +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SNestedDynamicBinding class' category: 'Powerlang-Core-SExpressions'! +SNestedDynamicBinding class + instanceVariableNames: ''! + +!SNestedDynamicBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^ aTreecodeDecoder decodeNestedDynamicVar +! ! + + diff --git a/modules/LMR/SExpressions/SNilBinding.Class.st b/modules/LMR/SExpressions/SNilBinding.Class.st new file mode 100644 index 00000000..ed6f716c --- /dev/null +++ b/modules/LMR/SExpressions/SNilBinding.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SNilBinding category: 'Powerlang-Core-SExpressions'! +SLiteralBinding subclass: #SNilBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SNilBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: 'NilId' +! ! + +!SNilBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:39'! +value + ^nil +! ! + +!SNilBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext + ^ anEvaluationContext nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SNilBinding class' category: 'Powerlang-Core-SExpressions'! +SNilBinding class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpAssign.Class.st b/modules/LMR/SExpressions/SOpAssign.Class.st new file mode 100644 index 00000000..252c5379 --- /dev/null +++ b/modules/LMR/SExpressions/SOpAssign.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpAssign category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpAssign + instanceVariableNames: 'assignees' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpAssign methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpAssign: self +! ! + +!SOpAssign methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +assignees + ^assignees +! ! + +!SOpAssign methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +assignees: aCollection + assignees := aCollection +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpAssign class' category: 'Powerlang-Core-SExpressions'! +SOpAssign class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpDispatchMessage.Class.st b/modules/LMR/SExpressions/SOpDispatchMessage.Class.st new file mode 100644 index 00000000..76b9d303 --- /dev/null +++ b/modules/LMR/SExpressions/SOpDispatchMessage.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpDispatchMessage category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpDispatchMessage + instanceVariableNames: 'message' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpDispatchMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpDispatchMessage: self +! ! + +!SOpDispatchMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +message + ^ message +! ! + +!SOpDispatchMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +message: anSMessage + message := anSMessage +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpDispatchMessage class' category: 'Powerlang-Core-SExpressions'! +SOpDispatchMessage class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpDropToS.Class.st b/modules/LMR/SExpressions/SOpDropToS.Class.st new file mode 100644 index 00000000..b5a434e1 --- /dev/null +++ b/modules/LMR/SExpressions/SOpDropToS.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpDropToS category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpDropToS + instanceVariableNames: 'count' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpDropToS methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpDropToS: self +! ! + +!SOpDropToS methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +count + ^count +! ! + +!SOpDropToS methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +count: anInteger + count := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpDropToS class' category: 'Powerlang-Core-SExpressions'! +SOpDropToS class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpJump.Class.st b/modules/LMR/SExpressions/SOpJump.Class.st new file mode 100644 index 00000000..0a7bdeaa --- /dev/null +++ b/modules/LMR/SExpressions/SOpJump.Class.st @@ -0,0 +1,35 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpJump category: 'Powerlang-Core-SExpressions'! +SInlinerOperation subclass: #SOpJump + instanceVariableNames: 'target' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpJump methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpJump: self +! ! + +!SOpJump methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: self class name withArticle; nextPutAll: ' after '; print: target +! ! + +!SOpJump methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +target + ^target +! ! + +!SOpJump methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +target: anInteger + target := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpJump class' category: 'Powerlang-Core-SExpressions'! +SOpJump class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpJumpFalse.Class.st b/modules/LMR/SExpressions/SOpJumpFalse.Class.st new file mode 100644 index 00000000..73d71a5e --- /dev/null +++ b/modules/LMR/SExpressions/SOpJumpFalse.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpJumpFalse category: 'Powerlang-Core-SExpressions'! +SOpJump subclass: #SOpJumpFalse + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpJumpFalse methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpJumpFalse: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpJumpFalse class' category: 'Powerlang-Core-SExpressions'! +SOpJumpFalse class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpJumpTrue.Class.st b/modules/LMR/SExpressions/SOpJumpTrue.Class.st new file mode 100644 index 00000000..b0d75bb0 --- /dev/null +++ b/modules/LMR/SExpressions/SOpJumpTrue.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpJumpTrue category: 'Powerlang-Core-SExpressions'! +SOpJump subclass: #SOpJumpTrue + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpJumpTrue methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpJumpTrue: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpJumpTrue class' category: 'Powerlang-Core-SExpressions'! +SOpJumpTrue class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpLoadRfromFrame.Class.st b/modules/LMR/SExpressions/SOpLoadRfromFrame.Class.st new file mode 100644 index 00000000..bc6df4a2 --- /dev/null +++ b/modules/LMR/SExpressions/SOpLoadRfromFrame.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpLoadRfromFrame category: 'Powerlang-Core-SExpressions'! +SInlinerOperation subclass: #SOpLoadRfromFrame + instanceVariableNames: 'index' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpLoadRfromFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpLoadRfromFrame: self +! ! + +!SOpLoadRfromFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index +^ index +! ! + +!SOpLoadRfromFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index: anInteger + index := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpLoadRfromFrame class' category: 'Powerlang-Core-SExpressions'! +SOpLoadRfromFrame class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpLoadRfromStack.Class.st b/modules/LMR/SExpressions/SOpLoadRfromStack.Class.st new file mode 100644 index 00000000..6c9d0b41 --- /dev/null +++ b/modules/LMR/SExpressions/SOpLoadRfromStack.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpLoadRfromStack category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpLoadRfromStack + instanceVariableNames: 'index' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpLoadRfromStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpLoadRfromStack: self +! ! + +!SOpLoadRfromStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index + ^index +! ! + +!SOpLoadRfromStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index: anInteger + index := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpLoadRfromStack class' category: 'Powerlang-Core-SExpressions'! +SOpLoadRfromStack class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpLoadRwithNil.Class.st b/modules/LMR/SExpressions/SOpLoadRwithNil.Class.st new file mode 100644 index 00000000..05034ce3 --- /dev/null +++ b/modules/LMR/SExpressions/SOpLoadRwithNil.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpLoadRwithNil category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpLoadRwithNil + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpLoadRwithNil methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpLoadRwithNil: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpLoadRwithNil class' category: 'Powerlang-Core-SExpressions'! +SOpLoadRwithNil class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpLoadRwithSelf.Class.st b/modules/LMR/SExpressions/SOpLoadRwithSelf.Class.st new file mode 100644 index 00000000..d95fa4ac --- /dev/null +++ b/modules/LMR/SExpressions/SOpLoadRwithSelf.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpLoadRwithSelf category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpLoadRwithSelf + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpLoadRwithSelf methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpLoadRwithSelf: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpLoadRwithSelf class' category: 'Powerlang-Core-SExpressions'! +SOpLoadRwithSelf class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpNonLocalReturn.Class.st b/modules/LMR/SExpressions/SOpNonLocalReturn.Class.st new file mode 100644 index 00000000..0e8902e6 --- /dev/null +++ b/modules/LMR/SExpressions/SOpNonLocalReturn.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpNonLocalReturn category: 'Powerlang-Core-SExpressions'! +SOpReturn subclass: #SOpNonLocalReturn + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpNonLocalReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpNonLocalReturn: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpNonLocalReturn class' category: 'Powerlang-Core-SExpressions'! +SOpNonLocalReturn class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpPopR.Class.st b/modules/LMR/SExpressions/SOpPopR.Class.st new file mode 100644 index 00000000..b0c72912 --- /dev/null +++ b/modules/LMR/SExpressions/SOpPopR.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpPopR category: 'Powerlang-Core-SExpressions'! +SInlinerOperation subclass: #SOpPopR + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpPopR methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpPopR: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpPopR class' category: 'Powerlang-Core-SExpressions'! +SOpPopR class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpPrimitive.Class.st b/modules/LMR/SExpressions/SOpPrimitive.Class.st new file mode 100644 index 00000000..a15e6592 --- /dev/null +++ b/modules/LMR/SExpressions/SOpPrimitive.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpPrimitive category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpPrimitive + instanceVariableNames: 'block' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpPrimitive methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpPrimitive: self +! ! + +!SOpPrimitive methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +block + ^block +! ! + +!SOpPrimitive methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +block: aBlockClosure + block := aBlockClosure +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpPrimitive class' category: 'Powerlang-Core-SExpressions'! +SOpPrimitive class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpPushR.Class.st b/modules/LMR/SExpressions/SOpPushR.Class.st new file mode 100644 index 00000000..96336da9 --- /dev/null +++ b/modules/LMR/SExpressions/SOpPushR.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpPushR category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpPushR + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpPushR methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpPushR: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpPushR class' category: 'Powerlang-Core-SExpressions'! +SOpPushR class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpRestart.Class.st b/modules/LMR/SExpressions/SOpRestart.Class.st new file mode 100644 index 00000000..85bd6890 --- /dev/null +++ b/modules/LMR/SExpressions/SOpRestart.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpRestart category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpRestart + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpRestart methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpRestart: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpRestart class' category: 'Powerlang-Core-SExpressions'! +SOpRestart class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpReturn.Class.st b/modules/LMR/SExpressions/SOpReturn.Class.st new file mode 100644 index 00000000..9125341b --- /dev/null +++ b/modules/LMR/SExpressions/SOpReturn.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpReturn category: 'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpReturn + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpReturn: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpReturn class' category: 'Powerlang-Core-SExpressions'! +SOpReturn class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOpStoreRintoFrame.Class.st b/modules/LMR/SExpressions/SOpStoreRintoFrame.Class.st new file mode 100644 index 00000000..60c57b67 --- /dev/null +++ b/modules/LMR/SExpressions/SOpStoreRintoFrame.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOpStoreRintoFrame category: 'Powerlang-Core-SExpressions'! +SInlinerOperation subclass: #SOpStoreRintoFrame + instanceVariableNames: 'index' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SOpStoreRintoFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^ visitor visitOpStoreRintoFrame: self +! ! + +!SOpStoreRintoFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index + ^ index +! ! + +!SOpStoreRintoFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index: anInteger + index := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOpStoreRintoFrame class' category: 'Powerlang-Core-SExpressions'! +SOpStoreRintoFrame class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SOperation.Class.st b/modules/LMR/SExpressions/SOperation.Class.st new file mode 100644 index 00000000..426f6150 --- /dev/null +++ b/modules/LMR/SExpressions/SOperation.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SOperation category: 'Powerlang-Core-SExpressions'! +SExpression subclass: #SOperation + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SOperation class' category: 'Powerlang-Core-SExpressions'! +SOperation class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SPragma.Class.st b/modules/LMR/SExpressions/SPragma.Class.st new file mode 100644 index 00000000..f23395f2 --- /dev/null +++ b/modules/LMR/SExpressions/SPragma.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SPragma category: 'Powerlang-Core-SExpressions'! +SExpression subclass: #SPragma + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SPragma methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^ name +! ! + +!SPragma methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aString + name := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SPragma class' category: 'Powerlang-Core-SExpressions'! +SPragma class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/SReturn.Class.st b/modules/LMR/SExpressions/SReturn.Class.st new file mode 100644 index 00000000..8cfc2bd7 --- /dev/null +++ b/modules/LMR/SExpressions/SReturn.Class.st @@ -0,0 +1,57 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SReturn category: 'Powerlang-Core-SExpressions'! +SExpression subclass: #SReturn + instanceVariableNames: 'local expression' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +acceptVisitor: visitor + ^visitor visitReturn: self +! ! + +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +expression + ^expression +! ! + +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +expression: anSExpression + expression := anSExpression +! ! + +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +isReturn + ^true +! ! + +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +local + ^local +! ! + +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +local: aBoolean + local := aBoolean +! ! + +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream indent: anInteger + aStream tab: anInteger; nextPutAll: '{ReturnId.'; cr. + expression printOn: aStream indent: anInteger + 1. + aStream nextPutAll: '}' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SReturn class' category: 'Powerlang-Core-SExpressions'! +SReturn class + instanceVariableNames: ''! + +!SReturn class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeReturn +! ! + + diff --git a/modules/LMR/SExpressions/SScript.Class.st b/modules/LMR/SExpressions/SScript.Class.st new file mode 100644 index 00000000..ae5a1a7b --- /dev/null +++ b/modules/LMR/SExpressions/SScript.Class.st @@ -0,0 +1,72 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SScript category: 'Powerlang-Core-SExpressions'! +SExpression subclass: #SScript + instanceVariableNames: 'statements compiledCode' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +argumentCount + ^compiledCode argumentCount +! ! + +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +compiledCode + ^compiledCode +! ! + +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +compiledCode: anObject + compiledCode := anObject +! ! + +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + statements := #() +! ! + +!SScript methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +optimizedCode: anObject + ^ self compiledCode optimizedCode: anObject +! ! + +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream indent: anInteger + statements + do: [:statement | statement printOn: aStream indent: anInteger + 1] + separatedBy: [aStream nextPutAll: '.'; cr] +! ! + +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +statements + ^statements +! ! + +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +statements: aCollection + statements := aCollection +! ! + +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +tempCount + ^compiledCode tempCount +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SScript class' category: 'Powerlang-Core-SExpressions'! +SScript class + instanceVariableNames: ''! + +!SScript class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + "return an initialized instance" + + ^ self basicNew initialize. + +! ! + + +SScript initialize! + diff --git a/modules/LMR/SExpressions/SSelfBinding.Class.st b/modules/LMR/SExpressions/SSelfBinding.Class.st new file mode 100644 index 00000000..dd49157a --- /dev/null +++ b/modules/LMR/SExpressions/SSelfBinding.Class.st @@ -0,0 +1,35 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SSelfBinding category: 'Powerlang-Core-SExpressions'! +SBinding subclass: #SSelfBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SSelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSelf + ^true +! ! + +!SSelfBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: 'SelfId' +! ! + +!SSelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext + ^ anEvaluationContext receiver +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SSelfBinding class' category: 'Powerlang-Core-SExpressions'! +SSelfBinding class + instanceVariableNames: ''! + +!SSelfBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^self new +! ! + + diff --git a/modules/LMR/SExpressions/SSuperBinding.Class.st b/modules/LMR/SExpressions/SSuperBinding.Class.st new file mode 100644 index 00000000..068b2d7e --- /dev/null +++ b/modules/LMR/SExpressions/SSuperBinding.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SSuperBinding category: 'Powerlang-Core-SExpressions'! +SSelfBinding subclass: #SSuperBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!SSuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSelf + ^false +! ! + +!SSuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSuper + ^true +! ! + +!SSuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: 'SuperId' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SSuperBinding class' category: 'Powerlang-Core-SExpressions'! +SSuperBinding class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/STemporaryBinding.Class.st b/modules/LMR/SExpressions/STemporaryBinding.Class.st new file mode 100644 index 00000000..5419d4bd --- /dev/null +++ b/modules/LMR/SExpressions/STemporaryBinding.Class.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STemporaryBinding category: 'Powerlang-Core-SExpressions'! +SLocalBinding subclass: #STemporaryBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!STemporaryBinding methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +assign: value within: anEvaluationContext + anEvaluationContext temporaryAt: position in: environment put: value +! ! + +!STemporaryBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isInCurrentEnvironment + ^environment = 1 +! ! + +!STemporaryBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isTemporary + ^true +! ! + +!STemporaryBinding methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream + nextPutAll: 'STemporary '; + print: position; + nextPutAll: ' @ env '; + print: environment +! ! + +!STemporaryBinding methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext + ^ anEvaluationContext temporaryAt: position in: environment +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STemporaryBinding class' category: 'Powerlang-Core-SExpressions'! +STemporaryBinding class + instanceVariableNames: ''! + +!STemporaryBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeTemporary +! ! + + diff --git a/modules/LMR/SExpressions/STrueBinding.Class.st b/modules/LMR/SExpressions/STrueBinding.Class.st new file mode 100644 index 00000000..b819340b --- /dev/null +++ b/modules/LMR/SExpressions/STrueBinding.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STrueBinding category: 'Powerlang-Core-SExpressions'! +SLiteralBinding subclass: #STrueBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!STrueBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: 'TrueId' +! ! + +!STrueBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +value + ^true +! ! + +!STrueBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +valueWithin: anEvaluationContext + ^ anEvaluationContext true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STrueBinding class' category: 'Powerlang-Core-SExpressions'! +STrueBinding class + instanceVariableNames: ''! + + diff --git a/modules/LMR/SExpressions/TreecodeDecoder.Class.st b/modules/LMR/SExpressions/TreecodeDecoder.Class.st new file mode 100644 index 00000000..90a2b4a5 --- /dev/null +++ b/modules/LMR/SExpressions/TreecodeDecoder.Class.st @@ -0,0 +1,330 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #TreecodeDecoder category: 'Powerlang-Core-SExpressions'! +Object subclass: #TreecodeDecoder + instanceVariableNames: 'method stream builder' + classVariableNames: 'BindingTypes NodeTypes' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +bindingTypeOf: id + ^ BindingTypes at: id +! ! + +!TreecodeDecoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +builder: aRuntime + builder := aRuntime +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeArgument + ^ SArgumentBinding new + index: self nextInteger; + environment: self nextEnvironment +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeAssignment + | assignment assignees | + assignment := SAssignment new. + + assignees := self nextExpressionArray. + assignment expression: self nextExpression. + assignees do: [ :identifier | assignment assign: identifier ]. + ^ assignment +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeBlock + + | expression inlined block index code | + expression := SBlock new. + inlined := self nextBoolean. + inlined + ifTrue: [ expression inlinedArgs: self nextArray ] + ifFalse: [ + index := self nextInteger. + block := self literalAt: index. + builder ifNotNil: [ + code := builder newExecutableCodeFor: expression. + builder blockExecutableCode: block put: code ]. + expression + compiledCode: block; + index: index; + capturedVariables: self nextArray ]. + expression statements: self nextExpressionArray. + ^ expression +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeCascade + | cascade receiver messages message count | + cascade := SCascade new. + receiver := self nextExpression. + count := self nextInteger. + messages := (1 to: count) + collect: [ :i | + message := SCascadeMessage decodeUsing: self. + message cascade: cascade ]. + ^ cascade + receiver: receiver; + messages: messages +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeCascadeMessage + | selector arguments | + selector := self nextSymbol. + arguments := self nextExpressionArray. + ^ SCascadeMessage new + selector: selector; + arguments: arguments +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeDynamicVar + ^ SDynamicBinding new name: self nextSymbol +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeIdentifier + | type binding | + type := self bindingTypeOf: self nextInteger. + binding := type decodeUsing: self. + ^ SIdentifier new binding: binding +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeLiteral + | index value | + index := self nextInteger. + value := index = 0 + ifTrue: [ self nextLiteralInteger ] + ifFalse: [ self literalAt: index ]. + ^ SLiteral new + index: index; + value: value +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeMessage + | inlined selector receiver arguments | + inlined := self nextBoolean. + selector := self nextSymbol. + receiver := self nextExpression. + arguments := self nextExpressionArray. + ^ SMessage new + receiver: receiver; + selector: selector; + arguments: arguments; + inlined: inlined +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeMethod + | type node next pragma | + type := stream next. + type !!= MethodId + ifTrue: [ self error: 'method treecode expected' ]. + node := SMethod new. + next := stream peek. + next = PragmaId + ifTrue: [ stream next. + pragma := SPragma new name: self nextSymbolOrNil. + node pragma: pragma ]. + node + compiledCode: method; + statements: self nextExpressionArray. + ^ node +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeNestedDynamicVar + ^ SNestedDynamicBinding new + name: + self nextSymbol. + +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeReturn + | expression local | + local := self nextBoolean. + expression := self nextExpression. + ^ SReturn new + local: local; + expression: expression +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +decodeTemporary + ^ STemporaryBinding new + index: self nextInteger; + environment: self nextEnvironment +! ! + +!TreecodeDecoder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +literalAt: anInteger + ^ builder ifNil: [method at: anInteger] ifNotNil: [builder method: method literalAt: anInteger] +! ! + +!TreecodeDecoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +method: aMethod + method := aMethod +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextArray + | count | + count := self nextInteger. + ^ stream next: count +! ! + +!TreecodeDecoder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextBoolean + ^ stream next = 1 +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextEnvironment + | value | + value := self nextInteger. + ^ value !!= -2 + ifTrue: [ value ] +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextExpression + | type | + type := self nodeTypeOf: stream next. + ^type decodeUsing: self. + +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextExpressionArray + | count | + count := self nextInteger. + ^(1 to: count) collect: [ :arg | self nextExpression ] +! ! + +!TreecodeDecoder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextInteger + | value | + value := stream next. + value = 16r80 + ifTrue: [ ^ stream int64 ]. + ^ value <= 127 + ifTrue: [ value ] + ifFalse: [ value - 16r100 ] +! ! + +!TreecodeDecoder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextLiteralInteger + | value | + value := self nextInteger. + ^ builder + ifNil: [ value ] + ifNotNil: [ builder newInteger: value ] +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextSymbol + | index | + index := self nextInteger. + ^ self literalAt: index +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextSymbolOrNil + | index | + index := self nextInteger. + ^index !!= 0 ifTrue: [ self literalAt: index] +! ! + +!TreecodeDecoder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextUnsignedInteger + | value | + value := self nextByte. + ^value < 128 + ifTrue: [value] + ifFalse: [value - 128 + (self nextUnsignedInteger bitShift: 7)] +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +nodeTypeOf: id + ^NodeTypes at: id +! ! + +!TreecodeDecoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +stream: aStream + stream := aStream +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TreecodeDecoder class' category: 'Powerlang-Core-SExpressions'! +TreecodeDecoder class + instanceVariableNames: 'BindingTypes NodeTypes'! + +!TreecodeDecoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializePools + "TODO: would be best to share this code with encoder. However, both can be loaded (or not) independently" + self addNamespaceAs: #BindingIds. + BindingIds + at: #NilId put: 1; + at: #TrueId put: 2; + at: #FalseId put: 3; + at: #ArgumentId put: 4; + at: #TemporaryId put: 5; + at: #SelfId put: 6; + at: #SuperId put: 7; + at: #DynamicVarId put: 14; + at: #NestedDynamicVarId put: 15; + at: #PushRid put: 50; + at: #PopRid put: 51. + + self addNamespaceAs: #TreecodeIds. + TreecodeIds + at: #MethodId put: 101; + at: #BlockId put: 102; + at: #IdentifierId put: 103; + at: #LiteralId put: 104; + at: #MessageId put: 105; + at: #CascadeId put: 106; + at: #BraceId put: 107; + at: #AssignmentId put: 108; + at: #ReturnId put: 109; + at: #PragmaId put: 110 + +! ! + +!TreecodeDecoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeBindingTypes + BindingTypes := Dictionary new. + BindingTypes + at: NilId put: SNilBinding; + at: TrueId put: STrueBinding; + at: FalseId put: SFalseBinding; + at: ArgumentId put: SArgumentBinding; + at: TemporaryId put: STemporaryBinding; + at: SelfId put: SSelfBinding; + at: SuperId put: SSuperBinding; + at: DynamicVarId put: SDynamicBinding; + at: NestedDynamicVarId put: SNestedDynamicBinding +! ! + +!TreecodeDecoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeNodeTypes + NodeTypes := Dictionary new. + NodeTypes + at: AssignmentId put: SAssignment; + at: BlockId put: SBlock; + at: CascadeId put: SCascade; + at: LiteralId put: SLiteral; + at: IdentifierId put: SIdentifier; + at: MessageId put: SMessage; + at: ReturnId put: SReturn +! ! + + diff --git a/modules/LMR/SendSite.Class.st b/modules/LMR/SendSite.Class.st new file mode 100644 index 00000000..8eb86884 --- /dev/null +++ b/modules/LMR/SendSite.Class.st @@ -0,0 +1,557 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #SendSite category: #Kernel! +Object subclass: #SendSite + instanceVariableNames: 'instructions cache format token tally' + classVariableNames: 'Instances Invoke LookupCount MICs MonomorphicStub NextMIC NextMICs NextPIC NextPICs PICs PolymorphicStub' + poolDictionaries: '' + category: 'Kernel'! +!SendSite commentStamp: '' prior: 0! + + Copyright (c) 2020-2022 Quorum Software. + See (MIT) license in root directory. +! + +!SendSite methodsFor: 'meta accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +_dispatchDebuggableOn: anObject + | cm nativeCode invoked | + #specialABIBegin. + #anObject -> #regR. + #self -> #regA. + #specialABIEnd. + LookupCount := LookupCount + 1. + cm := anObject _cachedLookup: token. + cm == nil ifTrue: [^anObject doesNotUnderstandSelector: token]. + invoked := Processor activeProcess wantsToStepInto + ifTrue: [cm debuggableCopy] + ifFalse: [cm]. + invoked prepareForExecution. + nativeCode := invoked nativeCode. + "self when: anObject behavior use: nativeCode code." + ^anObject _transferControlTo: nativeCode +! ! + +!SendSite methodsFor: 'meta accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +_dispatchDebuggableOn: anObject startingAt: aBehavior + | cm nativeCode invoked | + #specialABIBegin. + #anObject -> #regR. + #self -> #regA. + #aBehavior -> #regT. + #specialABIEnd. + LookupCount := LookupCount + 1. + cm := anObject _cachedLookup: token in: aBehavior. + cm == nil ifTrue: [^anObject doesNotUnderstandSelector: token]. + invoked := Processor activeProcess wantsToStepInto + ifTrue: [cm debuggableCopy] + ifFalse: [cm]. + invoked prepareForExecution. + nativeCode := invoked nativeCode. + "self when: aBehavior use: nativeCode code." + ^anObject _transferControlTo: nativeCode +! ! + +!SendSite methodsFor: 'meta accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +_dispatchOn: anObject + | cm nativeCode | + #specialABIBegin. + #anObject -> #regR. + #self -> #regA. + #specialABIEnd. + LookupCount := LookupCount + 1. + cm := anObject _cachedLookup: token. + cm == nil ifTrue: [^anObject doesNotUnderstandSelector: token]. + cm prepareForExecution. + nativeCode := cm nativeCode. + self when: anObject behavior use: nativeCode. + ^anObject _transferControlTo: nativeCode +! ! + +!SendSite methodsFor: 'meta accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +_dispatchOn: anObject startingAt: aBehavior + | cm nativeCode | + #specialABIBegin. + #anObject -> #regR. + #self -> #regA. + #aBehavior -> #regT. + #specialABIEnd. + LookupCount := LookupCount + 1. + cm := anObject _cachedLookup: token in: aBehavior. + cm == nil ifTrue: [^anObject doesNotUnderstandSelector: token]. + cm prepareForExecution. + nativeCode := cm nativeCode. + self beInvoke: cm using: Invoke. + ^anObject _transferControlTo: nativeCode +! ! + +!SendSite methodsFor: 'meta accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +_invokeOn: anObject + #savePreviousSelf. + #specialABIBegin. + #anObject -> #regR. + #self -> #regA. + #specialABIEnd. + ^anObject _transferControlTo: cache nativeCode +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +beInvoke: aCompiledMethod using: invokeInstructions + instructions := invokeInstructions. + token := aCompiledMethod selector. + cache := aCompiledMethod +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +bePolymorphic + format := format bitOr: IsPolymorphic +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +beStaticSend + format := format bitOr: IsStaticSend +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +beSuperSend + format := format bitOr: IsSuperSend +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +cache + ^cache +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +flush + self isStaticSend ifTrue: [^self]. + instructions := self isSuperSend + ifTrue: [Smalltalk at: #LookupSuperCode] + ifFalse: [Smalltalk at: #LookupCode]. + cache := nil. + tally := 0 +! ! + +!SendSite methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +flush: aSymbol + aSymbol == token ifTrue: [self flush] +! ! + +!SendSite methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasBeenReset + ^format isOnBit: HasBeenReset +! ! + +!SendSite methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + tally := 0. + format := 0 +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructions + ^instructions +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +instructions: aByteArray + instructions := aByteArray +! ! + +!SendSite methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isFakeMegamorphic + ^self isFakeMegamorphic: 3 +! ! + +!SendSite methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isFakeMegamorphic: maxImplementations + | d | + self isMegamorphic ifFalse: [^false]. + d := IdentitySet new. + cache size = 15 ifFalse: [^false]. + 1 to: cache size - 1 by: 2 do: [:i | | code | + code := cache at: i + 1. + d add: code]. + (cache at: cache size) ifNotNil: [:code | d add: code]. + ^d size <= maxImplementations +! ! + +!SendSite methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMegamorphic + ^self isPolymorphic and: [self hasBeenReset] +! ! + +!SendSite methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPolymorphic + ^format isOnBit: IsPolymorphic +! ! + +!SendSite methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isStaticSelector + (#(#basicByteAt: #basicByteAt:put: #basicInstVarAt: #basicInstVarAt:put: + #behavior #class #allocate:size: + #memory #instanceBehavior + #_instancesAreArrayed #_instancesHavePointers #nil:slotsOf: + #initializeExtended:contentSize: #primitiveNew + #primitiveNewBytes: #primitiveNewPointers: #_return: #_returnTo: #zero:bytesOf:) + includes: token) + ifTrue: [^true]. + ^ProtoObject staticSelectors includes: token +! ! + +!SendSite methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isStaticSend + ^(format bitAnd: IsStaticSend) == IsStaticSend +! ! + +!SendSite methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSuperSend + ^(format bitAnd: IsSuperSend) == IsSuperSend +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +maxSize + ^14 +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +monomorphicMap: aBehavior to: code + cache := self takeNextFreeMIC ifNil: [^self]. + instructions := self monomorphicStub. + cache + objectAtValid: 1 put: aBehavior; + objectAtValid: 2 put: code +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +monomorphicStub + ^MonomorphicStub code +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +polymorphicMap: aBehavior to: code + cache _size == 2 ifTrue: [ + cache := self takeNextFreePIC ifNil: [^self]. + tally := 0. + instructions := self polymorphicStub. + self bePolymorphic]. + aBehavior == SmallInteger instanceBehavior + ifTrue: [cache objectAtValid: self maxSize + 1 put: code] + ifFalse: [ + tally == self maxSize ifTrue: [self reset]. + cache + objectAtValid: tally + 1 put: aBehavior; + objectAtValid: tally + 2 put: code. + tally := tally + 2] +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +polymorphicStub + ^PolymorphicStub code +! ! + +!SendSite methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printInvokeTypeOn: aStream + aStream nextPutAll: 'invoke '; print: cache +! ! + +!SendSite methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printMonomorphicTypeOn: aStream + aStream + nextPutAll: 'mono ('; + print: cache first; + nextPutAll: ')' +! ! + +!SendSite methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream + nextPutAll: 'SendSite ('; + nextPutAll: token; + nextPutAll: ') ['. + self printTypeOn: aStream. + aStream nextPut: $] +! ! + +!SendSite methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printPolymorphicTypeOn: aStream + aStream nextPutAll: 'poly '. + (1 to: tally by: 2) + do: [:i | | behavior | + behavior := cache at: i. + aStream print: behavior] + separatedBy: [aStream nextPut: $,; space]. + (cache at: cache size) + ifNotNil: [aStream nextPutAll: ', '; print: SmallInteger behavior]. + aStream nextPutAll: ' -- old: '. + (tally + 1 to: cache size - 1 by: 2) + do: [:i | | behavior | + behavior := cache at: i. + aStream print: behavior] + separatedBy: [aStream nextPut: $,; space] +! ! + +!SendSite methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTypeOn: aStream + cache isCompiledMethod ifTrue: [^self printInvokeTypeOn: aStream]. + instructions == MonomorphicStub code + ifTrue: [^self printMonomorphicTypeOn: aStream]. + instructions == PolymorphicStub code + ifTrue: [^self printPolymorphicTypeOn: aStream]. + instructions == (Smalltalk at: #Lookup ifAbsent: ['']) + ifTrue: [^aStream nextPutAll: 'lookup']. + cache isCompiledMethod + ifTrue: [^aStream nextPutAll: 'dispatch ' , cache printString]. + aStream nextPutAll: 'other '; print: cache +! ! + +!SendSite methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +register + | sends | + sends := self class instances + at: self selector + ifAbsentPut: [OrderedCollection new]. + sends add: self +! ! + +!SendSite methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +reset + tally := 0. + format := format bitOr: HasBeenReset +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector + ^token +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector: aSymbol + token := aSymbol. + self isStaticSelector ifTrue: [self beStaticSend]. + Smalltalk isDMR ifTrue: [self register] +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +sentSelector + ^token +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +takeNextFreeMIC + | result | + result := MICs _basicAt: NextMIC. + NextMIC = MICs _size + ifTrue: [self class useNextMICs] + ifFalse: [NextMIC := NextMIC + 1]. + ^result +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +takeNextFreePIC + | result | + result := PICs _basicAt: NextPIC. + NextPIC = PICs _size + ifTrue: [self class useNextPICs] + ifFalse: [NextPIC := NextPIC + 1]. + ^result +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +unreset + format := format bitAnd: HasBeenReset bitInvert +! ! + +!SendSite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +when: aBehavior use: aNativeCode + cache == nil + ifTrue: [ + self isStaticSend + ifTrue: [ + instructions := Invoke. + cache := aNativeCode compiledCode] + ifFalse: [self monomorphicMap: aBehavior to: aNativeCode]] + ifFalse: [self polymorphicMap: aBehavior to: aNativeCode] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SendSite class' category: #Kernel! +SendSite class + instanceVariableNames: 'Instances Invoke LookupCount MICs MonomorphicStub NextMIC NextMICs NextPIC NextPICs PICs PolymorphicStub'! + +!SendSite class methodsFor: 'writing image' stamp: 'KenD 28/Jun/2026 13:27:39'! +ensureEnoughFreeCaches: anInteger + MICs _size - NextMIC < anInteger ifTrue: [self useNextMICs]. + PICs _size - NextPIC < (anInteger // 8) ifTrue: [self useNextPICs] +! ! + +!SendSite class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +flush: selector + | sends count copy | + sends := self instances at: selector ifAbsent: [^self]. + count := 0. + sends do: [:send | + send ifNotNil: [ + count := count + 1. + send flush: selector]]. + count * 3 < sends size ifFalse: [^self]. + count = 0 ifTrue: [^sends removeKey: selector]. + copy := WeakArray new: (count * 1.5) asInteger. + count := 0. + sends do: [:send | + send ifNotNil: [ + count := count + 1. + copy at: count put: send]]. + self instances at: selector put: copy +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +flushForRelease + self instances do: [:sites | sites do: [:s | s flush]]. + self flushInstances; useNextMICs; useNextPICs +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +flushInstances + Instances := nil +! ! + +!SendSite class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeFormatFlags + self addNamespaceAs: #FormatFlags. + FormatFlags + at: #IsStaticSend put: 0x1; + at: #IsSuperSend put: 0x2; + at: #IsPolymorphic put: 0x4; + at: #HasBeenReset put: 0x8 +! ! + +!SendSite class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeFrom: aNativizationEnvironment + self + reserveMoreMICs; + reserveMorePICsWith: aNativizationEnvironment lookup; + useNextMICs; + useNextPICsWith: aNativizationEnvironment lookup; + initializeMICStubFor: aNativizationEnvironment abi; + initializePICStubFor: aNativizationEnvironment abi. + Invoke := aNativizationEnvironment invokeStub +! ! + +!SendSite class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instances + Instances ifNil: [ + Instances := IdentityDictionary new. + self allInstances do: [:send | send register]]. + ^Instances +! ! + +!SendSite class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +invoking: aCompiledMethod using: instructions + ^self new beStaticSend; beInvoke: aCompiledMethod using: instructions +! ! + +!SendSite class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUndermethod: aSelector + ^self undermethodSelectors includes: aSelector +! ! + +!SendSite class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupCount + ^LookupCount +! ! + +!SendSite class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +mics + ^MICs +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectStaticSelectors + " + self undermethodSelectors asArray sort + " + ^#( +_beArrayed _beBytes _beLarge _beNamed _beNotRemembered _beRemembered _beSecondGeneration _beSeen _beSmall _beSpecial _beNotSpecial _beUnseen _copyBasicHeaderFrom: _copyHeaderSized:from: _flagsMask: _flagsSet: _hasBeenSeen _headerSizeInBytes _isArrayed _isBytes _isEphemeron _isFixed _isLarge _hasNamedSlots _isProxy _isRemembered _isSecondGeneration _isSmall _isSpecial _largeSize: _nextBasePointer _objectFromBasePointer _pointersSize _size _sizeInBytes _strongPointersSize ) +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +optimizedStaticSelectors + ^#(#basicByteAt: #basicByteAt:put: #byteAtValid: #byteAtValid:put: + #basicObjectAt: #basicObjectAt:put: #behavior #class #allocate:size: + #memory #instanceBehavior + #_instancesAreArrayed #_instancesHavePointers #nil:slotsOf: + #initializeExtended:contentSize: #primitiveNew + #primitiveNewBytes: #primitiveNewPointers: #_return: #_returnTo: #zero:bytesOf:) +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +reserveMoreMICs + " + The amount needs to be enough to execute all the code until either: + a. initializing the memory spaces; + b. reading the image. + If not, when exhausting the caches we will try to create a new GCSpace + but will raise errors because memory hasn't been initialized yet + " + | memory amount array mic | + memory := Smalltalk memory. + amount := 2000. + array := memory newLargeArray: amount. + mic := Array new: 2. + 1 to: amount do: [:i | array basicAt: i put: (memory pinnedCopy: mic)]. + NextMICs := array +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +reserveMorePICsWith: aNativeCode + | memory amount array lookup pic | + memory := Smalltalk memory. + amount := 1000. + array := memory newLargeArray: amount. + lookup := aNativeCode ifNil: [Smalltalk at: #Lookup]. + pic := (Array new: 15) + at: 15 put: lookup; + yourself. + 1 to: amount do: [:i | array basicAt: i put: (memory pinnedCopy: pic)]. + NextPICs := array +! ! + +!SendSite class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +sending: selector with: instructions + ^self new selector: selector; instructions: instructions +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +undermethods + ^LMRProtoObject methodDictionary values asArray select: [:m | m selector beginsWith: '_'] +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +undermethodSelectors + "^self organization selectorsFor: 'header access'" + ^self undermethods collect: [:method | method selector] +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +useNextMICs + MICs := NextMICs. + NextMIC := 1. + self reserveMoreMICs +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +useNextPICs + self useNextPICsWith: nil +! ! + +!SendSite class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +useNextPICsWith: aNativeCode + PICs := NextPICs. + NextPIC := 1. + self reserveMorePICsWith: aNativeCode +! ! + + +SendSite initialize! + diff --git a/modules/LMR/StackChunk.Class.st b/modules/LMR/StackChunk.Class.st new file mode 100644 index 00000000..fc2edfc6 --- /dev/null +++ b/modules/LMR/StackChunk.Class.st @@ -0,0 +1,91 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #StackChunk category: #Kernel! +Object subclass: #StackChunk + instanceVariableNames: 'sp bp base prev' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!StackChunk commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +base + ^base +! ! + +!StackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +base: anInteger + base := anInteger +! ! + +!StackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +bp + ^bp +! ! + +!StackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +bp: anInteger + bp := anInteger +! ! + +!StackChunk methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +callbacksDo: aBlock + | chunk | + chunk := self. + [chunk isForCallback] whileTrue: [ + aBlock value: chunk. + chunk := chunk prev] +! ! + +!StackChunk methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isForCallback + ^prev notNil +! ! + +!StackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +prev + ^prev +! ! + +!StackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +prev: aCallbackStackLink + prev := aCallbackStackLink +! ! + +!StackChunk methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +recordStackPointers + | frame dropped | + frame := StackFrameCursor top. + dropped := 4. + dropped timesRepeat: [frame moveNext]. + bp := frame current. + sp := frame previous + 8 _asPointer + - 8 _asPointer "is going to push 2 arguments for ffiCall:withArguments" +! ! + +!StackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +sp + ^sp +! ! + +!StackChunk methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +sp: anInteger + sp := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'StackChunk class' category: #Kernel! +StackChunk class + instanceVariableNames: ''! + +!StackChunk class methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:39'! +after: aCallbackStackLink + ^self new prev: aCallbackStackLink +! ! + + diff --git a/modules/LMR/StackFrameCursor.Class.st b/modules/LMR/StackFrameCursor.Class.st new file mode 100644 index 00000000..83d2393b --- /dev/null +++ b/modules/LMR/StackFrameCursor.Class.st @@ -0,0 +1,240 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #StackFrameCursor category: #Kernel! +Object subclass: #StackFrameCursor + instanceVariableNames: 'current previous' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel'! +!StackFrameCursor commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addObjectsTo: aCollection + self slotCount - 2 + to: 1 + by: -1 + do: [:i | aCollection add: (self slotAt: i)] +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +argumentAt: index + ^current _asObject _basicAt: 3 + index - 1 +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +argumentAt: index put: argument + current _asObject _basicAt: 3 + index - 1 put: argument +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +arguments + | arity arguments | + arity := self method arity. + arguments := Array new: arity. + self copy: arity argumentsInto: arguments. + ^arguments +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +argumentsWithArity: arity + | arguments | + arguments := Array new: arity. + self copy: arity argumentsInto: arguments. + ^arguments +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +caller + ^(current _asObject _basicAt: 1) _asPointer +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +callerFrame + ^self moveNext +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +context + ^current _asObject _basicAt: -2 +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +context: aContext + current _asObject _basicAt: -2 put: aContext +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +copy: arity argumentsInto: arguments + 1 + to: arity + do: [:i | arguments at: arity - i + 1 put: (self argumentAt: i)] +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyTo: basePointer + | size | + size := self slotCount - 1. + 1 to: size do: [:i | | slot | + slot := self slotAt: i. + basePointer _asObject _basicAt: 1 - i put: slot]. + ^basePointer - (size * WordSize) _asPointer +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +current + ^current +! ! + +!StackFrameCursor methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +current: bp previous: sp + previous := sp. + current := bp +! ! + +!StackFrameCursor methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +ended + ^current == 0 _asPointer +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +environment + ^current _asObject _basicAt: -3 +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +firstTemporary: temp + current _asObject _basicAt: -2 put: temp +! ! + +!StackFrameCursor methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasBlocks + | m | + m := self method. + ^m isBlock or: [m hasBlocks] +! ! + +!StackFrameCursor methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +method + ^current _asObject _basicAt: -1 +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +methodEnvironment + ^self method isBlock + ifTrue: [self environment methodEnvironment] + ifFalse: [self environment] +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +methodFrame + ^self method isBlock ifTrue: [self environment methodFrame] ifFalse: [self] +! ! + +!StackFrameCursor methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +moveLast + [self caller _asPointer == 0] whileFalse: [self moveNext] +! ! + +!StackFrameCursor methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +moveNext + previous := current. + current := self caller +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +objectsDo: aBlock + self slotCount - 2 to: 1 by: -1 do: [:i | aBlock value: (self slotAt: i)] +! ! + +!StackFrameCursor methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +pointTo: base + current := base +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +previous + ^previous +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver + ^current _asObject _basicAt: 0 +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +receiver: object + current _asObject _basicAt: 0 put: object +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +savedEnvironment + ^current _asObject _basicAt: -2 +! ! + +!StackFrameCursor methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +slideSlots: amount + current := current + (amount * WordSize _asPointer) +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +slotAt: index + ^current _asObject _basicAt: 1 - index +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +slotCount + ^current - previous // WordSize _asPointer +! ! + +!StackFrameCursor methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +stackPointer + ^current +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'StackFrameCursor class' category: #Kernel! +StackFrameCursor class + instanceVariableNames: ''! + +!StackFrameCursor class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: position + ^self new pointTo: position +! ! + +!StackFrameCursor class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +caller + ^self at: (self _framePointer _basicAt: 1) _asPointer +! ! + +!StackFrameCursor class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +classFor: aProcessStack + ^aProcessStack isNative + ifTrue: [StackFrameCursor] + ifFalse: [ReifiedStackFrameCursor] +! ! + +!StackFrameCursor class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aProcessStack + | class | + class := self classFor: aProcessStack. + ^class new current: aProcessStack lastFrame previous: aProcessStack top +! ! + +!StackFrameCursor class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +top + ^self at: self _framePointer _asPointer +! ! + + +StackFrameCursor initialize! + diff --git a/modules/LMR/Thread.Class.st b/modules/LMR/Thread.Class.st new file mode 100644 index 00000000..fbbb6185 --- /dev/null +++ b/modules/LMR/Thread.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #Thread category: #Kernel! +Object subclass: #Thread + instanceVariableNames: '' + classVariableNames: 'tlsGlobalDispatchCacheIndex' + poolDictionaries: '' + category: 'Kernel'! +!Thread commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Thread class' category: #Kernel! +Thread class + instanceVariableNames: 'tlsGlobalDispatchCacheIndex'! + +!Thread class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +currentGlobalLookup + ^tlsGlobalDispatchCacheIndex _getThreadValue +! ! + + diff --git a/modules/ModuleImporter/CharacterArray.Extension.st b/modules/ModuleImporter/CharacterArray.Extension.st new file mode 100644 index 00000000..56178123 --- /dev/null +++ b/modules/ModuleImporter/CharacterArray.Extension.st @@ -0,0 +1,28 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!CharacterArray methodsFor: '*CodeSpecsImporter' stamp: 'KenD 28/Jun/2026 13:27:37'! +unixToMac + | result | + result := self species new: self size. + self + withIndexDo: [:c :i | c = Lf + ifTrue: [result at: i put: Cr] + ifFalse: [result at: i put: c]]. + ^result +! ! + +!CharacterArray methodsFor: '*CodeSpecsImporter' stamp: 'KenD 28/Jun/2026 13:27:37'! +dosToUnix + ^self species streamContents: [:s | | source | + source := self readStream. + [source atEnd] whileFalse: [| c | + c := source next. + c = Cr + ifTrue: [ + s nextPut: Lf. + source next] + ifFalse: [s nextPut: c]]] +! ! + + diff --git a/modules/ModuleImporter/ModuleImporterModule.Class.st b/modules/ModuleImporter/ModuleImporterModule.Class.st new file mode 100644 index 00000000..0aa43f47 --- /dev/null +++ b/modules/ModuleImporter/ModuleImporterModule.Class.st @@ -0,0 +1,32 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ModuleImporterModule category: #ModuleImporter! +Module subclass: #ModuleImporterModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ModuleImporter'! +!ModuleImporterModule commentStamp: '' prior: 0! + + Copyright (c) 2022, Quorum Software. + See (MIT) license in root directory. +! + +!ModuleImporterModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(#InternalReadStream #Character #CharacterArray #IdentitySet #Module). + #Tonel -> #(#TonelReader). + #CodeSpecs -> #(#ModuleSpec #ClassSpec #MetaclassSpec #MethodSpec). + #STON -> #(#STONReader). + #Compiler -> #(#SCompiler). + } +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ModuleImporterModule class' category: #ModuleImporter! +ModuleImporterModule class + instanceVariableNames: ''! + + diff --git a/modules/ModuleImporter/ModuleLoader.Class.st b/modules/ModuleImporter/ModuleLoader.Class.st new file mode 100644 index 00000000..1abe5854 --- /dev/null +++ b/modules/ModuleImporter/ModuleLoader.Class.st @@ -0,0 +1,117 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ModuleLoader category: #ModuleImporter! +Object subclass: #ModuleLoader + instanceVariableNames: 'module spec' + classVariableNames: '' + poolDictionaries: '' + category: 'ModuleImporter'! +!ModuleLoader commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ModuleLoader methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:37'! +readModuleSpecNamed: aString + | reader | + reader := ModuleSpecReader new. + reader path: '../../modules/', aString. + ^reader read +! ! + +!ModuleLoader methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:37'! +loadModuleNamed: aString + | classes moduleName moduleSpec moduleClass | + spec := self readModuleSpecNamed: aString. + classes := self classesSortedBySuperclass: spec classes. + moduleName := ('.' split: spec name) last asSymbol. + moduleSpec := spec classes detect: [:cls | cls name = (moduleName , #Module)] ifNone: nil. + moduleSpec ifNil: [ moduleSpec := spec classes detect: [:cls | cls name = (#Module , moduleName)] ifNone: nil]. + moduleSpec + ifNil: [ + moduleClass := Module.] + ifNotNil: [ + moduleClass := self createNewClassFrom: moduleSpec in: nil. + classes remove: moduleSpec ]. + module := self createNewModule: moduleClass. + module name isEmpty ifTrue: [ module name: moduleName asString ]. + classes do: [:c | self createNewClassFrom: c in: module ]. + spec extendedClasses do: [:c | self createExtensionMethodsOf: c ]. + module justLoaded. + Kernel loadedModules at: module name asSymbol put: module. + ^ module +! ! + +!ModuleLoader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +classesSortedBySuperclass: anArray + | result seen s dfs | + result := OrderedCollection new. + seen := IdentitySet new. + dfs := [ :class | + s := class superclass. + ((anArray includes: s) andNot: [ seen includes: s ]) ifTrue: [ + dfs value: s ]. + result add: class. + seen add: class ]. + anArray do: [ :class | (seen includes: class) ifFalse: [ dfs value: class ] ]. + self ASSERT: result asSet = anArray asSet. + ^ result +! ! + +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! +createNewClassFrom: aClassSpec in: module + | superclass metaclass class | + superclass := (module ifNil: [ Kernel ]) namespace at: aClassSpec supername asSymbol. + class := Class newSubclassOf: superclass. + metaclass := class class. + class name: aClassSpec name; instVarNames: aClassSpec instVarNames; classVarNames: aClassSpec classVarNames. + aClassSpec methods do: [ :m | self createNewMethod: m in: class ]. + aClassSpec metaclass methods do: [ :m | self createNewMethod: m in: metaclass ]. + module ifNotNil: [ + module addClass: class. + class module: module]. + ^ class +! ! + +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! +createNewMethod: aMethodSpec in: aSpecies + | method selector | + method := SCompiler new compile: aMethodSpec sourceCode. + selector := method selector. + method classBinding: aSpecies. + aSpecies methodDictionary at: selector put: method. + aSpecies organization classify: selector under: method category. + ^method +! ! + +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! +createNewModule: aClass + | module | + module := aClass new. + module bindKernelExports; importRequiredModules. + aClass name !!= #Module ifTrue: [ aClass module: module. module addClass: aClass]. + ^module +! ! + +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! +createExtensionMethodsOf: aClassSpec + | class metaclass | + class := module namespace at: aClassSpec name asSymbol. + metaclass := class behavior classBinding. + aClassSpec methods do: [ :m | | cm | + cm := self createNewMethod: m in: class. + module ifNotNil: [ module addExtension: cm ] ]. + aClassSpec metaclass methods do: [ :m | | cm | + cm := self createNewMethod: m in: metaclass. + module ifNotNil: [ module addExtension: cm ] ]. + ^ module +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ModuleLoader class' category: #ModuleImporter! +ModuleLoader class + instanceVariableNames: ''! + + diff --git a/modules/ModuleImporter/ModuleSpecReader.Class.st b/modules/ModuleImporter/ModuleSpecReader.Class.st new file mode 100644 index 00000000..d0b465e3 --- /dev/null +++ b/modules/ModuleImporter/ModuleSpecReader.Class.st @@ -0,0 +1,155 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:38 pm'! +!classDefinition: #ModuleSpecReader category: #ModuleSpecReader! +Object subclass: #ModuleSpecReader + instanceVariableNames: 'module path metadata' + classVariableNames: '' + poolDictionaries: '' + category: 'ModuleSpecReader'! +!ModuleSpecReader commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +read + self readMetadata; readClasses; readExtendedClasses. + ^module +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readClass: aString + | filename reader definition pointers variable class metasclass stream contents | + filename := path / aString , '.st'. + contents := Kernel readFile: filename. + contents size = 0 ifTrue: [ + filename := path / aString , '.class.st'. + contents := Kernel readFile: filename. + contents size = 0 ifTrue: [ + self error: 'Cannot find file for class ' , aString]]. + stream := InternalReadStream on: contents. + reader := TonelReader on: stream. + [reader read] ensure: [stream close]. + definition := reader definition. + variable := pointers := true. + definition at: #type ifPresent: [:type | + variable := true. + type = #bytes ifTrue: [pointers := false]]. + class := ClassSpec new + module: module; + name: (definition at: #name) asString; + supername: (definition at: #superclass ifAbsent: nil) asString; + ivars: (definition at: #instVars ifAbsent: #()); + cvarNames: (definition at: #classVars ifAbsent: #()); + sharedPools: (definition at: #pools ifAbsent: #()); + isVariable: variable; + isPointers: pointers. + metasclass := MetaclassSpec new + module: module; + instanceClass: class; + ivars: (definition at: #classInstVars ifAbsent: #()). + class metaclass: metasclass. + module addClass: class. + reader methods do: [:m | self readMethod: m] +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readClasses + (metadata at: #classes) do: [:name | self readClass: name] +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readExtendedClass: aString + + | filename contents stream reader definition class metaclass | + filename := path / aString , '.st'. + contents := Kernel readFile: filename. + contents size = 0 ifTrue: [ + self error: 'Cannot find file for extended class ' , aString]. + stream := InternalReadStream on: contents. + reader := TonelReader on: stream. + [reader read] ensure: [stream close]. + definition := reader definition. + class := ClassSpec new + module: module; + name: (definition at: #name) asString. + metaclass := MetaclassSpec new module: module; instanceClass: class. + class metaclass: metaclass. + module addClassExtension: class. + reader methods do: [:m | self readMethod: m] +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readExtendedClasses + (metadata at: #extendedClasses ifAbsent: [#()]) + do: [:name | self readExtendedClass: name] +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readMetadata + | stream name classes | + stream := (Kernel readFile: path , '/package.st') readStream. + stream throughAll: 'Package '. + metadata := (STONReader on: stream) parseMap. + name := (metadata at: #name) replace: $- with: Character space. + module name: name asString. + classes := metadata at: #classes. + classes := classes copyWith: name asString, 'Module'. + metadata at: #classes put: classes +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readMethod: aDictionary + | classname selector category class signature body source method | + classname := aDictionary at: #class. + selector := aDictionary at: #selector. + category := aDictionary at: #category. + class := module resolveClass: classname. + class isNil ifTrue: [ + self + error: 'Cannot find class for method ' , classname , ' >> #' + , selector asString]. + signature := aDictionary at: #signature. + body := aDictionary at: #body. + source := signature dosToUnix unixToMac , String cr + , body dosToUnix unixToMac. + method := MethodSpec new + module: module; + classBinding: class; + selector: selector; + category: category; + source: source. + class addMethod: method +! ! + +!ModuleSpecReader methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + module := ModuleSpec new +! ! + +!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +module + ^module +! ! + +!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +module: aModuleSpec + module := aModuleSpec +! ! + +!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +path: aFilename + path := aFilename +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ModuleSpecReader class' category: #ModuleSpecReader! +ModuleSpecReader class + instanceVariableNames: ''! + + +ModuleSpecReader initialize! + diff --git a/modules/NOS/Devices/Memory/Memory.Class.st b/modules/NOS/Devices/Memory/Memory.Class.st new file mode 100644 index 00000000..96a5e5fd --- /dev/null +++ b/modules/NOS/Devices/Memory/Memory.Class.st @@ -0,0 +1,71 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #Memory category: 'SqueakNOS-Devices-Memory'! +HardwareDevice subclass: #Memory + instanceVariableNames: 'size blocks' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Memory'! +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +alreadyReserved: anInterval for: aString + blocks add: (MemoryBlock from: anInterval first to: anInterval last description: aString) +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +biggestEmptyBlock + "Answers the biggest free block of memory" + ^self emptyBlocks detectMax: [ :block | block interval last - block interval first ]. +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +emptyBlocks + "Calculate all the free memory blocks. The algorithm assumes that used blocks are ordered and not overlapping." + | emptyBlocks nextBlockStart | + emptyBlocks := OrderedCollection new. + nextBlockStart := 0. + blocks do: [:block | + block start > nextBlockStart + ifTrue: [ + emptyBlocks add: (MemoryBlock from: nextBlockStart to: block start - 1 description: 'Empty') + ]. + nextBlockStart := block end + 1. + ]. + nextBlockStart < size ifTrue: [emptyBlocks add: (MemoryBlock from: nextBlockStart to: size - 1 description: 'Empty') ]. + ^emptyBlocks. + +! ! + +!Memory methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + blocks := OrderedCollection new. +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +size + ^size +! ! + +!Memory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +size: anInteger + "memory size in bytes" + size := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Memory class' category: 'SqueakNOS-Devices-Memory'! +Memory class + instanceVariableNames: ''! + +!Memory class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + | memory | + memory := aComputer memory: (self atMemoryAddress: 0). + aComputer setInitialMemoryState. + ^memory +! ! + + +Memory initialize! + diff --git a/modules/NOS/Devices/Memory/MemoryBlock.Class.st b/modules/NOS/Devices/Memory/MemoryBlock.Class.st new file mode 100644 index 00000000..f8213a80 --- /dev/null +++ b/modules/NOS/Devices/Memory/MemoryBlock.Class.st @@ -0,0 +1,55 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #MemoryBlock category: 'SqueakNOS-Devices-Memory'! +Object subclass: #MemoryBlock + instanceVariableNames: 'interval description' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Memory'! +!MemoryBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +description + ^description +! ! + +!MemoryBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +description: aString + description := aString +! ! + +!MemoryBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +end + ^interval last +! ! + +!MemoryBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +interval + ^interval +! ! + +!MemoryBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +interval: anInterval + interval := anInterval +! ! + +!MemoryBlock methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + ^aStream nextPutAll: self interval first printString; nextPut: $-; nextPutAll: self interval last printString; nextPut: $(;nextPutAll: self description; nextPut: $) +! ! + +!MemoryBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +start + ^interval first +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MemoryBlock class' category: 'SqueakNOS-Devices-Memory'! +MemoryBlock class + instanceVariableNames: ''! + +!MemoryBlock class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +from: start to: end description: aString + ^self new interval: (Interval from: start to: end); description: aString +! ! + + diff --git a/modules/NOS/Devices/Memory/MemoryManagerStrategy.Class.st b/modules/NOS/Devices/Memory/MemoryManagerStrategy.Class.st new file mode 100644 index 00000000..8fad48f8 --- /dev/null +++ b/modules/NOS/Devices/Memory/MemoryManagerStrategy.Class.st @@ -0,0 +1,45 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #MemoryManagerStrategy category: 'SqueakNOS-Memory-Manager'! +Object subclass: #MemoryManagerStrategy + instanceVariableNames: 'memory processor' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Memory-Manager'! +!MemoryManagerStrategy methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +memory + ^memory +! ! + +!MemoryManagerStrategy methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +memory: aMemory + memory := aMemory +! ! + +!MemoryManagerStrategy methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +processor + ^processor +! ! + +!MemoryManagerStrategy methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +processor: aProcessor + processor := aProcessor. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MemoryManagerStrategy class' category: 'SqueakNOS-Memory-Manager'! +MemoryManagerStrategy class + instanceVariableNames: ''! + +!MemoryManagerStrategy class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +forMemory: aMemory + ^self new memory: aMemory; identityMapping +! ! + +!MemoryManagerStrategy class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +forMemory: aMemory using: aProcessor + ^self new memory: aMemory; processor: aProcessor; identityMapping +! ! + + diff --git a/modules/NOS/Devices/Network/InternalNetworkDevice.Class.st b/modules/NOS/Devices/Network/InternalNetworkDevice.Class.st new file mode 100644 index 00000000..a5398168 --- /dev/null +++ b/modules/NOS/Devices/Network/InternalNetworkDevice.Class.st @@ -0,0 +1,84 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #InternalNetworkDevice category: 'SqueakNOS-Net-Devices'! +Stream subclass: #InternalNetworkDevice + instanceVariableNames: 'mtu' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Devices'! +!InternalNetworkDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +atEnd + ^ self subclassResponsibility +! ! + +!InternalNetworkDevice methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:24'! +down + ^ self +! ! + +!InternalNetworkDevice methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + mtu := 1024 +! ! + +!InternalNetworkDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +input: aPacket + self triggerEvent: #input: with: aPacket +! ! + +!InternalNetworkDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mtu + ^ mtu +! ! + +!InternalNetworkDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mtu: anInteger + mtu := anInteger +! ! + +!InternalNetworkDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +next + ^ self nextPacket +! ! + +!InternalNetworkDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextPacket + ^ self subclassResponsibility +! ! + +!InternalNetworkDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextPut: aPacket + ^ self nextPacketPut: aPacket +! ! + +!InternalNetworkDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +output: aPacket + ^ self subclassResponsibility +! ! + +!InternalNetworkDevice methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + aStream nextPutAll: self class name. + aStream nextPutAll: ' mtu='; print: self mtu +! ! + +!InternalNetworkDevice methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:24'! +up + ^ self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InternalNetworkDevice class' category: 'SqueakNOS-Net-Devices'! +InternalNetworkDevice class + instanceVariableNames: ''! + +!InternalNetworkDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +new + ^ self basicNew initialize +! ! + + +InternalNetworkDevice initialize! + diff --git a/modules/NOS/Devices/Network/LanceNICInitializationBlock16.Class.st b/modules/NOS/Devices/Network/LanceNICInitializationBlock16.Class.st new file mode 100644 index 00000000..0cca7e7b --- /dev/null +++ b/modules/NOS/Devices/Network/LanceNICInitializationBlock16.Class.st @@ -0,0 +1,296 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #LanceNICInitializationBlock16 category: 'SqueakNOS-Devices-Network'! +ExternalStructure subclass: #LanceNICInitializationBlock16 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Network'! +!LanceNICInitializationBlock16 commentStamp: '' prior: 0! + +16 bits version of the initialization block. +see http://www.amd.com/files/connectivitysolutions/networking/archivednetworking/19436.pdf +page 156 +! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +address + ^ self pointer asInteger +! ! + +!LanceNICInitializationBlock16 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +is16 + ^ true +! ! + +!LanceNICInitializationBlock16 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +is32 + ^ false +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +ladrf0 + "This method was automatically generated" + ^handle unsignedLongAt: 9 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +ladrf0: anObject + "This method was automatically generated" + handle unsignedLongAt: 9 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +ladrf1 + "This method was automatically generated" + ^handle unsignedLongAt: 13 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +ladrf1: anObject + "This method was automatically generated" + handle unsignedLongAt: 13 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +logicalAddressFilter + ^ self ladrf1 << 32 + self ladrf0 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +logicalAddressFilter: a64BitsInteger + self ladrf0: (a64BitsInteger bitAnd: 16rFFFFFFFF). + self ladrf1: (a64BitsInteger >> 32 bitAnd: 16rFFFFFFFF). + + +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mac0 + "This method was automatically generated" + ^handle unsignedShortAt: 3 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mac0: anObject + "This method was automatically generated" + handle unsignedShortAt: 3 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mac1 + "This method was automatically generated" + ^handle unsignedShortAt: 5 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mac1: anObject + "This method was automatically generated" + handle unsignedShortAt: 5 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mac2 + "This method was automatically generated" + ^handle unsignedShortAt: 7 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mac2: anObject + "This method was automatically generated" + handle unsignedShortAt: 7 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +macAddress + | addr | + addr := self mac2 << 16 + self mac1 << 16 + self mac0. + ^ EthernetAddress fromInteger: addr +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +macAddress: anEthernetAddress + | a6BytesInteger | + a6BytesInteger := anEthernetAddress asInteger. + self mac0: (a6BytesInteger bitAnd: 16rFFFF). + self mac1: (a6BytesInteger >> 16 bitAnd: 16rFFFF). + self mac2: (a6BytesInteger >> 32 bitAnd: 16rFFFF). + +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mode + "This method was automatically generated" + ^handle unsignedShortAt: 1 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mode: anObject + "This method was automatically generated" + handle unsignedShortAt: 1 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +rdra0 + "This method was automatically generated" + ^handle unsignedShortAt: 17 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +rdra0: anObject + "This method was automatically generated" + handle unsignedShortAt: 17 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +rdra1 + "This method was automatically generated" + ^handle unsignedByteAt: 19 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +rdra1: anObject + "This method was automatically generated" + handle unsignedByteAt: 19 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveRing + ^ LanceNICReceiveRingDescriptor16 fromHandle: (ExternalAddress new fromInteger: (self receiveRingAddress)) +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveRing: aLanceNICReceiveRing + ^ self receiveRingAddress: aLanceNICReceiveRing address +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveRingAddress + ^ self rdra1 << 16 + self rdra0 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveRingAddress: address + ((address bitXor: self address) bitAnd: 16rFF000000) isZero + ifFalse: [^ self error: 'In 16 bits mode the address for the receive buffer must share the higher byte with that of the initialization block']. + self rdra0: (address bitAnd: 16rFFFF). + ^ self rdra1: (address >> 16 bitAnd: 16rFF) +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveRingLen + ^ self rlen >> 5 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveRingLen: ringLen + ^ self rlen: ringLen << 5 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +rlen + "This method was automatically generated" + ^handle unsignedByteAt: 20 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +rlen: anObject + "This method was automatically generated" + handle unsignedByteAt: 20 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +tdra0 + "This method was automatically generated" + ^handle unsignedShortAt: 21 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +tdra0: anObject + "This method was automatically generated" + handle unsignedShortAt: 21 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +tdra1 + "This method was automatically generated" + ^handle unsignedByteAt: 23 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +tdra1: anObject + "This method was automatically generated" + handle unsignedByteAt: 23 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +tlen + "This method was automatically generated" + ^handle unsignedByteAt: 24 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +tlen: anObject + "This method was automatically generated" + handle unsignedByteAt: 24 put: anObject +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitRing + ^ LanceNICTransmitRingDescriptor16 fromHandle: (ExternalAddress new fromInteger: (self transmitRingAddress)) +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitRing: aLanceNICTransmitRing + ^ self transmitRingAddress: aLanceNICTransmitRing address +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitRingAddress + ^ self tdra1 << 16 + self tdra0 + (self address bitAnd: 16rFF000000) +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitRingAddress: address + ((address bitXor: self address) bitAnd: 16rFF000000) isZero + ifFalse: [^ self error: 'In 16 bits mode all addresses must share the higher byte']. + self tdra0: (address bitAnd: 16rFFFF). + ^ self tdra1: (address >> 16 bitAnd: 16rFF) +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitRingLen + ^ self tlen >> 5 +! ! + +!LanceNICInitializationBlock16 methodsFor: 'accessing - noauto' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitRingLen: ringLen + ^ self tlen: ringLen << 5 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LanceNICInitializationBlock16 class' category: 'SqueakNOS-Devices-Network'! +LanceNICInitializationBlock16 class + instanceVariableNames: ''! + +!LanceNICInitializationBlock16 class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +fields + "self defineFields" + ^#( + (mode 'ushort') + (mac0 'ushort') + (mac1 'ushort') + (mac2 'ushort') + (ladrf0 'ulong') + (ladrf1 'ulong') + (rdra0 'ushort') + (rdra1 'byte') + (rlen 'byte') + (tdra0 'ushort') + (tdra1 'byte') + (tlen 'byte') + ) +! ! + + diff --git a/modules/NOS/Devices/Network/LanceNICReceiveRingDescriptor16.Class.st b/modules/NOS/Devices/Network/LanceNICReceiveRingDescriptor16.Class.st new file mode 100644 index 00000000..dc58547e --- /dev/null +++ b/modules/NOS/Devices/Network/LanceNICReceiveRingDescriptor16.Class.st @@ -0,0 +1,101 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #LanceNICReceiveRingDescriptor16 category: 'SqueakNOS-Devices-Network'! +LanceNICRingDescriptor16 subclass: #LanceNICReceiveRingDescriptor16 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Network'! +!LanceNICReceiveRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +bufferError + "Buffer error is set any time the PCnet-PCI II controller does not + own the next buffer while data chaining a received frame. This + can occur in either of two ways: + 1. The OWN bit of the next buffer is ZERO. + 2. FIFO overflow occurred before the PCnet-PCI II controller + was able to read the OWNbit of the next descriptor. + If a Buffer Error occurs, an Overflow Error may also occur + internally in the FIFO, but will not be reported in the descriptor status + entry unless both BUFF and OFLO errors occur at the same + time. BUFF is set by the PCnet-PCI II controller and cleared + by the host." + ^ self flagsBit: 2 +! ! + +!LanceNICReceiveRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +bufferErrorClear + ^ self flagsBitClear: 2 +! ! + +!LanceNICReceiveRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +crcError + "CRC indicates that the receiver has detected a CRC (FCS) error + on the incoming frame. CRC is valid only when ENP is set and + OFLO is not. CRC is set by the PCnet-PCI II controller and + cleared by the host." + ^ self flagsBit: 3 +! ! + +!LanceNICReceiveRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +crcErrorClear + ^ self flagsBitClear: 3 +! ! + +!LanceNICReceiveRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameError + "Framing error indicates that the incoming frame contains a + non-integer multiple of eight bits and there was an FCS error. If + there was no FCS error on the in coming frame, then FRAM will + not be set even if there was a non-integer multiple of eight bits + in the frame. FRAM is not valid in internal loopback mode. FRAM is + valid only when ENP is set and OFLO is not. FRAM is set by the + PCnet-PCI II controller and cleared by the host." + + ^ self flagsBit: 5 +! ! + +!LanceNICReceiveRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameErrorClear + ^ self flagsBitClear: 5 +! ! + +!LanceNICReceiveRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +messageSize + "Message Byte Count is the length in bytes of the received + message, expressed as an unsigned binary integer. MCNT is + valid only when ERR is clear and ENP is set. MCNT is written by + the PCnet-PCI II controller and cleared by the host." + ^ self mcnttdr - 4 +! ! + +!LanceNICReceiveRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +messageSize: size + "Message Byte Count is the length in bytes of the received + message, expressed as an unsigned binary integer. MCNT is + valid only when ERR is clear and ENP is set. MCNT is written by + the PCnet-PCI II controller and cleared by the host." + ^ self mcnttdr: size +! ! + +!LanceNICReceiveRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +overflowError + "Overflow error indicates that the receiver has lost all or part of the + incoming frame, due to an inability to move data from the receive + FIFO into a memory buffer before the internal FIFO overflowed. + OFLO is valid only when ENP is not set. OFLO is set by the PC- + net-PCI II controller and cleared by the host." + ^ self flagsBit: 4 +! ! + +!LanceNICReceiveRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +overflowErrorClear + ^ self flagsBitClear: 4 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LanceNICReceiveRingDescriptor16 class' category: 'SqueakNOS-Devices-Network'! +LanceNICReceiveRingDescriptor16 class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Devices/Network/LanceNICRingDescriptor16.Class.st b/modules/NOS/Devices/Network/LanceNICRingDescriptor16.Class.st new file mode 100644 index 00000000..141a3bc8 --- /dev/null +++ b/modules/NOS/Devices/Network/LanceNICRingDescriptor16.Class.st @@ -0,0 +1,252 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #LanceNICRingDescriptor16 category: 'SqueakNOS-Devices-Network'! +ExternalStructure subclass: #LanceNICRingDescriptor16 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Network'! +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +address + ^ self pointer asInteger +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +anyError + "ERR is the OR of FRAM, OFLO, CRC, BUFF or BPE. ERR is set + by the PCnet-PCI II controller and cleared by the host." + + ^ self flagsBit: 6 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +anyErrorClear + ^ self flagsBitClear: 6 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +badr0 + "This method was automatically generated" + ^handle unsignedShortAt: 1 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +badr0: anObject + "This method was automatically generated" + handle unsignedShortAt: 1 put: anObject +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +badr1 + "This method was automatically generated" + ^handle unsignedByteAt: 3 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +badr1: anObject + "This method was automatically generated" + handle unsignedByteAt: 3 put: anObject +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +bcnt + "This method was automatically generated" + ^handle unsignedShortAt: 5 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +bcnt: anObject + "This method was automatically generated" + handle unsignedShortAt: 5 put: anObject +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +beOwnedByCard + ^ self flagsBitSet: 7 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +beOwnedByHost + ^ self flagsBitClear: 7 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +buffer + ^ ExternalAddress new fromInteger: (self bufferAddress) +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +buffer: anExternalAddress + ^ self bufferAddress: anExternalAddress asInteger + +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +bufferAddress + ^ self badr1 << 16 + self badr0 + (self address bitAnd: 16rFF000000) +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +bufferAddress: address + ((address bitXor: self address) bitAnd: 16rFF000000) isZero + ifFalse: [^ self error: 'In 16 bits mode all addresses must share the higher byte']. + self badr0: (address bitAnd: 16rFFFF). + ^ self badr1: (address >> 16 bitAnd: 16rFF) +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +bufferSize + "BCNT Buffer Byte Count is the length of the buffer pointed to + by this de scriptor, expressed as the two's complement of the + length of the buffer. This field is written by the host and + unchanged by the PCnet-PCI II controller." + ^ 16r10000 - self bcnt +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +bufferSize: size + ^ self bcnt: (size negated bitAnd: 16rFFFF) +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +endOfPacketClear + ^ self flagsBitClear: 0 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +endOfPacketSet + ^ self flagsBitSet: 0 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +flags + "This method was automatically generated" + ^handle unsignedByteAt: 4 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +flags: anObject + "This method was automatically generated" + handle unsignedByteAt: 4 put: anObject +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +flagsBit: index + ^ self flags anyMask: 1 << index +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +flagsBitClear: index + ^ self flags: (self flags bitAnd: (1 << index) bitInvert) +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +flagsBitSet: index + ^ self flags: (self flags bitOr: 1 << index) +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +isEndOfPacket + "End of Packet (ENP) indicates that this is the last buffer used by the + PCnet-PCI II controller for this frame. It is used for data chaining + buffers. If both STP and ENP are set, the frame fits into one buffer + and there is no data chaining. ENP is set by the PCnet-PCI II controller + and cleared by the host." + ^ self flagsBit: 0 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +isOwnedByCard + ^ self flagsBit: 7 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +isOwnedByHost + ^ self isOwnedByCard not +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +isStartOfPacket + "Start of Packet (STP) indicates that this is the first buffer used by the + PCnet-PCI II controller for this frame. If STP and ENP are both + set to ONE, the frame fits into a single buffer. Otherwise, the + frame is spread over more than one buffer. When LAPPEN + (CSR3, bit 5) is cleared to ZERO, STP is set by the PCnet-PCI II + controller and cleared by the host. When LAPPEN is set to + ONE, STP must be set by the host." + ^ self flagsBit: 1 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mcnttdr + "This method was automatically generated" + ^handle unsignedShortAt: 7 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mcnttdr: anObject + "This method was automatically generated" + handle unsignedShortAt: 7 put: anObject +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +mcnttdrBit: index + ^ self mcnttdr anyMask: 1 << index +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +mcnttdrBitClear: index + ^ self mcnttdr: (self mcnttdr bitAnd: (1 << index) bitInvert) +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +mcnttdrBitSet: index + ^ self mcnttdr: (self mcnttdr bitOr: 1 << index) +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +message + ^ self buffer stringAt: 1 size: self messageSize +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +message: aString + ^ self buffer stringAt: 1 put: aString +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +reset + self + flags: 0; + mcnttdr: 0. +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +startOfPacketClear + ^ self flagsBitClear: 1 +! ! + +!LanceNICRingDescriptor16 methodsFor: 'accessing - no auto' stamp: 'KenD 28/Jun/2026 13:32:24'! +startOfPacketSet + ^ self flagsBitSet: 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LanceNICRingDescriptor16 class' category: 'SqueakNOS-Devices-Network'! +LanceNICRingDescriptor16 class + instanceVariableNames: ''! + +!LanceNICRingDescriptor16 class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +fields + "self defineFields" + ^#( + (badr0 'ushort') + (badr1 'byte') + (flags 'byte') + (bcnt 'ushort') + (mcnttdr 'ushort') + ) +! ! + + diff --git a/modules/NOS/Devices/Network/LanceNICTransmitRingDescriptor16.Class.st b/modules/NOS/Devices/Network/LanceNICTransmitRingDescriptor16.Class.st new file mode 100644 index 00000000..e9f4e993 --- /dev/null +++ b/modules/NOS/Devices/Network/LanceNICTransmitRingDescriptor16.Class.st @@ -0,0 +1,264 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #LanceNICTransmitRingDescriptor16 category: 'SqueakNOS-Devices-Network'! +LanceNICRingDescriptor16 subclass: #LanceNICTransmitRingDescriptor16 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Network'! +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +bufferError + "bit 15 - BUFF + Buffer error is set by the PCnet-PCI II controller during transmission + when the PCnet-PCI II controller does not find the ENP flag in the + current descriptor and does not own the next descriptor. + This can occur in either of two ways: + 1. The OWN bit of the next descriptor is ZERO. + 2. FIFO underflow occurred before the PCnet-PCI II + controller obtained the STATUS byte (TMD1[31:24]) of + the next descriptor. BUFF is set by the PCnet-PCI II + controller and cleared by the host. + + If a Buffer Error occurs, an Underflow Error will also occur. + BUFF is not valid when LCOL or RTRY error is set during transmit + data chaining. BUFF is set by the PCnet-PCI II controller and + cleared by the host." + ^ self mcnttdrBit: 15 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +bufferErrorClear + ^ self mcnttdrBitClear: 15 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableCRCGeneration + "clearing this bit will not automatically disable CRC generation. + read comment on #enableCRCGeneration" + ^ self flagsBitClear: 5 + + +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableTransmitInterrupt + "bit 4 - LTINT + When LTINTEN is set to ONE this bit functions as LTINT on + host write operations and on PCnet-PCI II controller read operations. + + LTINT is used to suppress interrupts after successful transmission + on selected frames. When LTINT is cleared to ZERO and + ENP (End of Packet) is set to ONE, the PCnet-PCI II controller will not + set TINT (CSR0, bit 9) after a successful transmission. TINT will + only be set when the last descriptor of a frame has both LTINT and + ENP set to ONE. When LTINT is cleared to ZERO, it will only + cause the suppression of interrupts for successful transmission. + TINT will always be set if the transmission has an error. The + LTINTEN overrides the function of TOKINTD (CSR5, bit 15)." + ^ self flagsBitClear: 4 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCRCGeneration + "bit 5 - ADD_FCS + ADD_FCS dynamically controls the generation of FCS on a frame + by frame basis. It is valid only if the STP (Start of Packet) bit is set. + When ADD_FCS is set, the state of DXMTFCS is ignored and trans- + mitter FCS generation is activated. When ADD_FCS is cleared to + ZERO, FCS generation is controlled by DXMTFCS. When + APAD_XMT (CSR4, bit 11) is set to ONE, the setting of ADD_FCS + has no effect. ADD_FCS is set by the host, and is not changed by + the PCnet-PCI II controller. This is a reserved bit in the C-LANCE + (Am79C90). This function differs from the corresponding ILACC + function." + ^ self flagsBitSet: 5 + + +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableTransmitInterrupt + "bit 4 - LTINT + When LTINTEN is set to ONE this bit functions as LTINT on + host write operations and on PCnet-PCI II controller read operations. + + LTINT is used to suppress interrupts after successful transmission + on selected frames. When LTINT is cleared to ZERO and + ENP (End of Packet) is set to ONE, the PCnet-PCI II controller will not + set TINT (CSR0, bit 9) after a successful transmission. TINT will + only be set when the last descriptor of a frame has both LTINT and + ENP set to ONE. When LTINT is cleared to ZERO, it will only + cause the suppression of interrupts for successful transmission. + TINT will always be set if the transmission has an error. The + LTINTEN overrides the function of TOKINTD (CSR5, bit 15)." + ^ self flagsBitSet: 4 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +excessiveDeferralError + "Excessive Deferral. Indicates that the transmitter has experienced + Excessive Deferral on this transmit frame, where Excessive + Deferral is defined in ISO 8802-3 (IEEE/ANSI 802.3). Excessive + Deferral will also set the interrupt bit EXDINT (CSR5, bit 7)." + ^ self mcnttdrBit: 13 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +excessiveDeferralErrorClear + ^ self mcnttdrBitClear: 13 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +lateCollisionError + "Late Collision indicates that a collision has occurred after the first + slot time of the channel has elapsed. The PCnet-PCI II con- + troller does not retry on late collisions. LCOL is set by the + PCnet-PCI II controller and cleared by the host." + ^ self mcnttdrBit: 12 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +lateCollisionErrorClear + ^ self mcnttdrBitClear: 12 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +lossOfCarrierError + "bit 11 - LCAR + Loss of Carrier is set when the carrier is lost during a PCnet-PCI II + controller-initiated transmission when in AUI mode and the device + is operating in half-duplex mode. The PCnet-PCI II controller does + not retry upon loss of carrier. It will continue to transmit the whole + frame until done. LCAR will not be set when the device is operating + in full-duplex mode and the AUI port is active. LCAR is not + valid in Internal Loopback Mode. + LCAR is set by the PCnet-PCI II controller and cleared by the host. + In 10BASE-T mode, LCAR will be set when the T-MAU was in Link + Fail state during the transmission." + ^ self mcnttdrBit: 11 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +lossOfCarrierErrorClear + ^ self mcnttdrBitClear: 11 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +message: aString + super message: aString. + self + bufferSize: aString size; + startOfPacketSet; + endOfPacketSet; + beOwnedByCard. +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +messageSize + ^ self bufferSize +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +neededDefer + "bit 2 - DEF + Deferred indicates that the PCnet-PCI II controller had to defer + while trying to transmit a frame. This condition occurs if the channel + is busy when the PCnet-PCI II controller is ready to transmit. + DEF is set by the PCnet-PCI II controller and cleared by the host." + ^ self flagsBit: 2 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +neededDeferClear + ^ self flagsBitClear: 2 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +neededMultipleRetries + "bit 4 - MORE/LTINT + MORE indicates that more than one retry was needed to transmit + a frame. The value of MORE is written by the PCnet-PCI II controller. + This bit has meaning only if the ENP bit is set." + ^ self flagsBit: 4 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +neededMultipleRetriesClear + ^ self flagsBitClear: 4 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +neededOneRetry + "bit 3 - ONE + ONE indicates that exactly one retry was needed to transmit a + frame. ONE flag is not valid when LCOL is set. The value of the + ONE bit is written by the PCnet-PCI II controller. This bit has + meaning only if the ENP bit is set." + ^ self flagsBit: 3 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +neededOneRetryClear + ^ self flagsBitClear: 3 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +retryError + " bit 10 - RTRY + Retry error indicates that the transmitter has failed after 16 + attempts to successfully transmit a message, due to repeated + collisions on the medium. If DRTY is set to ONE in the MODE + register, RTRY will set after 1 failed transmission attempt. + RTRY is set by the PCnet-PCI II controller and cleared by the host." + ^ self mcnttdrBit: 10 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +retryErrorClear + ^ self mcnttdrBitClear: 10 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +timeDomainReflectometer + "nice method name eh!! not my imagination thought :-) + TDR Time Domain Reflectometer reflects the state of an internal + PCnet-PCI II controller counter that counts at a 10 MHz rate from the + start of a transmission to the occurrence of a collision or loss of + carrier. This value is useful in determining the approximate distance + to a cable fault. The TDR value is written by the PCnet-PCI II + controller and is valid only if RTRY is set. + Note that 10 MHz gives very low resolution and in general has not + been found to be particularly useful. This feature is here primarily + to maintain full compatibility with the C-LANCE device (Am79C90)." + ^ self mcnttdr bitAnd: 16r3FF +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +underflowError + " bit 14 - UFLO + Underflow error indicates that the transmitter has truncated a + message because it could not read data from memory fast enough. + UFLO indicates that the FIFO has emptied before the end of the + frame was reached. When DXSUFLO (CSR3, bit 6) is cleared to + ZERO, the transmitter is turned off when an UFLO error + occurs (CSR0, TXON = 0). When DXSUFLO is set to ONE + the PCnet-PCI II controller grace fully recovers from an UFLO + error. It scans the transmit descriptor ring until it finds the + start of a new frame and starts a new transmission. + UFLO is set by the PCnet-PCI II controller and cleared by the + host." + ^ self mcnttdrBit: 14 +! ! + +!LanceNICTransmitRingDescriptor16 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +underflowErrorClear + ^ self mcnttdrBitClear: 14 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LanceNICTransmitRingDescriptor16 class' category: 'SqueakNOS-Devices-Network'! +LanceNICTransmitRingDescriptor16 class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Devices/Network/LancePCIDevice.Class.st b/modules/NOS/Devices/Network/LancePCIDevice.Class.st new file mode 100644 index 00000000..f12a2c24 --- /dev/null +++ b/modules/NOS/Devices/Network/LancePCIDevice.Class.st @@ -0,0 +1,620 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #LancePCIDevice category: 'SqueakNOS-Devices-Network'! +NetworkingDevice subclass: #LancePCIDevice + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Network'! +!LancePCIDevice commentStamp: '' prior: 0! + +Only "working" for PCI, however, we use 16 bits mode so it's more compatible with older ISA cards, try with: + +LancePCIDevice installOn: Computer current. +Computer current defaultNetworkInterface macAddress hex. + +Information from: + +GRUB Legacy's source in netboot/lance.c netboot/pci.c and netboot/config.c +(from this sources, we are assuming PCI, and with that ENABLE_AUTOSELECT and no MUST_UNREST) + +Am79C972 +http://www.amd.com/us-en/assets/content_type/white_papers_and_tech_docs/21485_pt1.pdf +http://www.amd.com/us-en/assets/content_type/white_papers_and_tech_docs/21485_pt2.pdf +Specially pages starting at: 91 of part 1 + +Am79C970 +http://www.amd.com/files/connectivitysolutions/networking/archivednetworking/19436.pdf + +More Tech Info from AMD: +http://www.amd.com/us-en/ConnectivitySolutions/DesignWithAMD (Networking Tech Docs, Archived Tech Docs) +! + +!LancePCIDevice methodsFor: 'accessing - basic' stamp: 'KenD 28/Jun/2026 13:32:24'! +address + ^ self shortAt: 16r12 +! ! + +!LancePCIDevice methodsFor: 'accessing - basic' stamp: 'KenD 28/Jun/2026 13:32:24'! +address: word + ^ self shortAt: 16r12 put: word +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +anyError + "bit 15 - ERR + Error is set by the ORing of BABL, CERR, MISS, and MERR. + ERR remains set as long as any of the error flags are true. + Read accessible always. ERR is read only. Write operations are + ignored." + + ^ self statusBit: 15 +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +automaticMediaSelection + ^ self miscConfiguration: (self miscConfiguration bitOr: 2r10) +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +bablError + "bit 14 - BABL + Babble is a transmitter time-out error. BABL is set by the + PCnet-PCI II controller when the (CSR112) also increments each + transmitter has been on the channel longer than the time required + to send the maximum length frame. BABL will be set if 1519 bytes or + greater are transmitted. + + When BABL is set, INTA is asserted if IENA is ONE and the + mask bit BABLM (CSR3, bit 14) is ZERO. BABL assertion will set + the ERR bit, regardless of the settings of IENA and BABLM. + + Read/Write accessible always. BABL is cleared by the host by + writing a ONE. Writing a ZERO has no effect. BABL is cleared by + H_RESET, S_RESET or by setting the STOP bit." + + ^ self statusBit: 14 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +bablErrorReset + ^ self statusBitSet: 14 +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +busControlData + ^ self shortAt: 16r16 +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +busControlData: word + ^ self shortAt: 16r16 put: word +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +busControlWord: index + self address: index. + ^ self busControlData +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +busControlWord: index put: word + ^ self + address: index; + busControlData: word. +! ! + +!LancePCIDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +chipVersion + self controlStatusAddress: 88. + self controlStatusAddress ~= 88 ifTrue: [^ 0]. " version 0 does not reflect addresses " + + ^ (self controlStatusWord: 89) << 16 + (self controlStatusWord: 88) +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +collisionError + "bit 13 - CERR + Collision Error is set by the PC=net-PCI II controller when the + device operates in half-duplex mode and the collision inputs to + the AUI port failed to activate within 20 network bit times after + the chip terminated transmission (SQE Test). This feature is a + transceiver test feature. CERR reporting is disabled when the + AUI interface is active and the PCnet-PCI II controller operates in + full-duplex mode. + In 10BASE-T mode, for both half-duplex and full-duplex operation, + CERR will be set after a transmission if the T-MAU is in Link Fail state. + CERR assertion will not result in an interrupt being generated. + CERR assertion will set the ERR bit. + Read/Write accessible always. CERR is cleared by the host by + writing a ONE. Writing a ZERO has no effect. CERR is cleared by + H_RESET, S_RESET or by setting the STOP bit." + + ^ self statusBit: 13 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +collisionErrorReset + ^ self statusBitSet: 13 +! ! + +!LancePCIDevice methodsFor: 'accessing - control status' stamp: 'KenD 28/Jun/2026 13:32:24'! +controlStatusData + ^ self shortAt: 16r10 +! ! + +!LancePCIDevice methodsFor: 'accessing - control status' stamp: 'KenD 28/Jun/2026 13:32:24'! +controlStatusData: word + ^ self shortAt: 16r10 put: word +! ! + +!LancePCIDevice methodsFor: 'accessing - control status' stamp: 'KenD 28/Jun/2026 13:32:24'! +controlStatusWord: index + self address: index. + ^ self controlStatusData +! ! + +!LancePCIDevice methodsFor: 'accessing - control status' stamp: 'KenD 28/Jun/2026 13:32:24'! +controlStatusWord: index put: word + ^ self + address: index; + controlStatusData: word. +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +demandTransmition + "bit 3 - TDMD + Transmit Demand, when set, causes the buffer management + unit to access the transmit descriptor ring without waiting for + the poll-time counter to elapse. If TXON is not enabled, TDMD bit + will be cleared and no transmit descriptor ring access will occur. + If the DPOLL bit in CSR4 is set, automatic polling is disabled and + TDMD can be used to start a transmission. + Read/Write accessible always. TDMD is set by writing a ONE. + Writing a ZERO has no effect. TDMD will be cleared by the buffer + management unit when it polls a transmit descriptor. TDMD is + cleared by H_RESET, S_RESET or by setting the STOP bit." + ^ self statusBitSet: 3 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableInterrupts + ^ self statusBitClear: 6 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableInterrupts + "bit 6 - IENA + Interrupt Enable allows INTA to be active if the Interrupt Flag is + set. If IENA is cleared to ZERO, INTA will be disabled regardless + of the state of INTR. + Read/Write accessible always. IENA is set by writing a ONE and + cleared by writing a ZERO. IENA is cleared by H_RESET, + S_RESET or by setting the STOP bit." + ^ self statusBitSet: 6 +! ! + +!LancePCIDevice methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleIRQ + | statusOnEntry | + statusOnEntry := self status. + [ + self receiveInterruptPending + ifTrue: [self handleReceiveInterrupt]. + self transmitInterruptPending + ifTrue: []. + ] on: Error do: [:ex | Transcript show: ex; cr]. + self status: statusOnEntry +! ! + +!LancePCIDevice methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleReceiveInterrupt + | ring pkt | + ring := self initializationBlock receiveRing. + ring isOwnedByHost ifTrue: [ + pkt := EthernetPacket bytes: ring message. + ring beOwnedByCard. + self input: pkt. + ]. +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +init + " bit 0 - INIT + INIT assertion enables the PCnet-PCI II controller to begin the + initialization procedure which reads the initialization block from + memory. Setting INIT clears the STOP bit. If STRT and INIT are + set together, the PCnet-PCI II controller initialization will be + performed first. INIT is not cleared. If when the initialization + sequence has completed. + Read/Write accessible always. INIT is set by writing a ONE. + Writing a ZERO has no effect. INIT is cleared by H_RESET, S_RESET + or by setting the STOP bit." + + ^ self status: 1 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +initAndStart + "by spec. INIT+START clear STOP. INIT is done before START" + ^ self status: 3 +! ! + +!LancePCIDevice methodsFor: 'accessing - control status' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializationBlock + ^ self is16 + ifTrue: [LanceNICInitializationBlock16 fromHandle: ( + ExternalAddress new fromInteger: (self initializationBlockAddress))] + ifFalse: [self notYetImplemented] + +! ! + +!LancePCIDevice methodsFor: 'accessing - control status' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializationBlock: aLanceNICInitBlock + aLanceNICInitBlock is16 + ifTrue: [ + self + softwareStyleRegister: 0; + initializationBlockAddress: aLanceNICInitBlock address] + ifFalse: [self notYetImplemented] + +! ! + +!LancePCIDevice methodsFor: 'accessing - control status' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializationBlockAddress + ^ (self controlStatusWord: 2) << 16 + (self controlStatusWord: 1) +! ! + +!LancePCIDevice methodsFor: 'accessing - control status' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializationBlockAddress: addr + ^ self + controlStatusWord: 1 put: (addr bitAnd: 16rFFFF); + controlStatusWord: 2 put: (addr >> 16). +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializationDone + "bit 8 - IDON + Initialization Done is set by the PCnet-PCI II controller after the + initialization sequence has completed. When IDON is set, the + PCnet-PCI II controller has read the initialization block from mem- + ory. + When IDON is set, INTA is asserted if IENA is ONE and the + mask bit IDONM (CSR3, bit 8) is ZERO. + Read/Write accessible always. IDON is cleared by the host by + writing a ONE. Writing a ZERO has no effect. IDON is cleared by + H_RESET, S_RESET or by setting the STOP bit." + ^ self statusBit: 8 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializationDoneReset + ^ self statusBitSet: 8 +! ! + +!LancePCIDevice methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + | initBlock tring rring rbuf tbuf | + "Note that the hw specification requires that all rring, tring, and initBlock are aligned to 8 bytes. + We assume this is the case in a x86_64 FFI what this has to be checked" + rbuf := ExternalAddress allocate: 1536. + rring := (LanceNICReceiveRingDescriptor16 externalNew) + reset; + buffer: rbuf; + bufferSize: 1536; + messageSize: 0; + beOwnedByCard. + + tbuf := ExternalAddress allocate: 1536. + tring := (LanceNICTransmitRingDescriptor16 externalNew) + reset; + buffer: tbuf; + beOwnedByHost. + + initBlock := (LanceNICInitializationBlock16 externalNew) + mode: 0; "auto media" + macAddress: self macAddress; + logicalAddressFilter: 0; + transmitRing: tring; + transmitRingLen: 0; + receiveRing: rring; + receiveRingLen: 0. + + self + stop; + initializationBlock: initBlock; + testAndFeaturesControl: 2r0100111101111111; + automaticMediaSelection; + initAndStart. + + " 2r0100.1111.0111.1111 = (page 112 of Am79C790A pdf) + 0,1 No Jabber IRQ + reset Jabber flag. + 2,3 No Transmit Start IRQ + reset Transmit status. + 4,5 No Receive Collition Counter overflow IRQ + reset RCVCCO. + 6 Clear user interrupt flag. + 7 No User Interrupt Command. + 8,9 No Clear Missed Frame Counter overflow IRQ + clear MFCO. + 10 Auto Strip Receive Padding (may we want to see it?) + 11 Auto Pad Outgoing. + 12 No Disable Auto Transmit Polling + 13 No Enable Bus Timer + 14 Disable DMA Plus transfer counter. + 15 Disable EN124 (No Runt Packet Accept) + " + + self enableInterrupts. +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptPending + "bit 7 - INTR + Interrupt Flag indicates that one or more following interrupt + causing conditions has occurred: BABL, EXDINT, IDON, JAB, + MERR, MISS, MFCO, MPINT, RVCC, RINT, SINT, SLPINT, TINT, + TXSTRT or UINT and the associated mask or enable bit is + programmed to allow the event to cause an interrupt. If IENA is set + to ONE and INTR is set, INTA will be active. When INTR is set by + SINT or SLPINT, INTA will be active independent of the state of + INEA. + Read accessible always. INTR is read only. INTR is cleared by + clearing all of the active individual interrupt bits that have not been + masked out." + ^ self statusBit: 7 +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +is16 + ^ (self softwareStyleRegister bitAnd: 16rF) isZero +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +is32 + ^ self is16 not +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +isReceiveEnabled + "bit 5 - RXON + Receive On indicates that the receive function is enabled. RXON + is set to ONE if DRX (CSR15, bit 0) is cleared to ZERO after the + START bit is set. If INIT and START are set together, RXON + will not be set until after the initialization block has been read in. + Read accessible always. RXON is read only. RXON is cleared by + H_RESET, S_RESET or by setting the STOP bit." + ^ self statusBit: 5 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +isTransmitEnabled + "bit 4 - TXON + Transmit On indicates that the transmit function is enabled. TXON + is set to ONE if DTX (CSR15, bit 1) is cleared to ZERO after the + START bit is set. If INIT and START are set together, TXON + will not be set until after the initialization block has been read in. + Read accessible always. TXON is read only. TXON is cleared by + H_RESET, S_RESET or by setting the STOP bit." + ^ self statusBit: 4 +! ! + +!LancePCIDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +isValid + | ver | + self reset: self reset. + (self controlStatusWord: 0) ~= 4 ifTrue: [^ false]. + ver := self chipVersion. + (ver isZero or: [(ver bitAnd: 16rFFF) == 3]) + ifFalse: [^ false]. + ^ true +! ! + +!LancePCIDevice methodsFor: 'accessing - basic' stamp: 'KenD 28/Jun/2026 13:32:24'! +macAddress + | answer | + answer := self controlStatusWord: 14. + answer := answer << 16 + (self controlStatusWord: 13). + answer := answer << 16 + (self controlStatusWord: 12). + ^ answer "EthernetAddress fromInteger: answer" +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +memoryError + "bit 11 - MERR + Memory Error is set by the PCnet-PCI II controller when it re- + quests the use of the system interface bus by asserting REQ + and GNT has not been asserted after a programmable length of + time. The length of time in microseconds before MERR is asserted + will depend upon the setting of the Bus Timeout register + (CSR100). The default setting of CSR100 will set MERR after + 153.6 ¨µs of bus latency. + When MERR is set, INTA is asserted if IENA is ONE and the + mask bit MERRM (CSR3, bit 11) is ZERO. MERR assertion will set + the ERR bit, regardless of the settings of IENA and MERRM. + Read/Write accessible always. MERR is cleared by the host by + writing a ONE. Writing a ZERO has no effect. MERR is cleared + by H_RESET, S_RESET or by setting the STOP bit." + + ^ self statusBit: 11 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +memoryErrorReset + ^ self statusBitSet: 11 +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +miscConfiguration + ^ self busControlWord: 2 +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +miscConfiguration: config + ^ self busControlWord: 2 put: config +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +missedFrameError + "bit 12 - MISS + Missed Frame is set by the PCnet-PCI II controller when it + looses an incoming receive frame because a receive descriptor was + not available. This bit is the only immediate indication that receive + data has been lost since there is no current receive descriptor. + The Missed Frame Counter (CSR112) also increments each + time a receive frame is missed. + When MISS is set, INTA is asserted if IENA is ONE and the mask + bit MISSM (CSR3, bit 12) is ZERO. MISS assertion will set the + ERR bit, regardless of the settings of IENA and MISSM. + Read/Write accessible always. MISS is cleared by the host by + writing a ONE. Writing a ZERO has no effect. MISS is cleared by + H_RESET, S_RESET or by setting the STOP bit." + + ^ self statusBit: 12 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +missedFrameErrorReset + ^ self statusBitSet: 12 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveInterruptPending + "bit 10 - RINT + Receive Interrupt is set by the PCnet-PCI II controller after the + last descriptor of a receive frame has been updated by writing a + ZERO to the OWN bit. RINT may also be set when the first descriptor + of a receive frame has been updated by writing a ZERO to the + OWN bit if the LAPPEN bit of CSR3 has been set to ONE. + When RINT is set, INTA is asserted if IENA is ONE and the mask + bit RINTM (CSR3, bit 10) is ZERO. + Read/Write accessible always. RINT is cleared by the host by + writing a ONE. Writing a ZERO has no effect. RINT is cleared by + H_RESET, S_RESET or by setting the STOP bit." + ^ self statusBit: 10 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveInterruptPendingReset + ^ self statusBitSet: 10 +! ! + +!LancePCIDevice methodsFor: 'accessing - basic' stamp: 'KenD 28/Jun/2026 13:32:24'! +reset + ^ self byteAt: 16r14 +! ! + +!LancePCIDevice methodsFor: 'accessing - basic' stamp: 'KenD 28/Jun/2026 13:32:24'! +reset: byte + ^ self byteAt: 16r14 put: byte +! ! + +!LancePCIDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +sendNow: anEthernetPacket + self initializationBlock transmitRing message: anEthernetPacket asString +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +softwareStyleRegister + ^ self busControlWord: 20 +! ! + +!LancePCIDevice methodsFor: 'accessing - bus control' stamp: 'KenD 28/Jun/2026 13:32:24'! +softwareStyleRegister: newStyle + ^ self busControlWord: 20 put: newStyle +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +start + " bit 1 - STRT + STRT assertion enables the PCnet-PCI II controller to send and + receive frames and perform buffer management operations. Set- + ting STRT clears the STOP bit. If STRT and INIT are set together, + the PCnet-PCI II controller initialization will be performed first. + Read/Write accessible always. STRT is set by writing a ONE. + Writing a ZERO has no effect. STRT is cleared by H_RESET, + S_RESET or by setting the STOP bit." + + ^ self statusBitSet: 2 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +status + ^ self controlStatusWord: 0 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +status: status + ^ self controlStatusWord: 0 put: status +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusBit: index + ^ self status anyMask: 1 << index +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusBitClear: index + ^ self status: (self status bitAnd: (1 << index) bitInvert) +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusBitSet: index + ^ self status: (self status bitOr: 1 << index) +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +stop + " bit 2 - STOP + STOP assertion disables the chip from all DMA and network activi ty. + The chip remains inactive until either STRT or INIT are set. If STOP, + STRT and INIT are all set together, STOP will override STRT and INIT. + Read/Write accessible always. STOP is set by writing a ONE, by + H_RESET or S_RESET. Writing a ZERO has no effect. STOP is + cleared by setting either STRT or INIT." + + ^ self status: 4 +! ! + +!LancePCIDevice methodsFor: 'accessing - control status' stamp: 'KenD 28/Jun/2026 13:32:24'! +testAndFeaturesControl + ^ self controlStatusWord: 4 +! ! + +!LancePCIDevice methodsFor: 'accessing - control status' stamp: 'KenD 28/Jun/2026 13:32:24'! +testAndFeaturesControl: word + ^ self controlStatusWord: 4 put: word +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitInterruptPending + "bit 9 - TINT + Transmit Interrupt is set by the PCnet-PCI II controller after the + OWN bit in the last descriptor of a transmit frame has been cleared + to indicate the frame has been sent or an error occurred in the + transmission. When TINT is set, INTA is asserted if IENA is ONE + and the mask bit TINTM (CSR3,bit 9) is ZERO." + ^ self statusBit: 9 +! ! + +!LancePCIDevice methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitInterruptPendingReset + ^ self statusBitSet: 9 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LancePCIDevice class' category: 'SqueakNOS-Devices-Network'! +LancePCIDevice class + instanceVariableNames: ''! + +!LancePCIDevice class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +deviceId + ^ 16r2000 +! ! + +!LancePCIDevice class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +vendorId + ^ 16r1022 +! ! + + +LancePCIDevice initialize! + diff --git a/modules/NOS/Devices/Network/Loopback.Class.st b/modules/NOS/Devices/Network/Loopback.Class.st new file mode 100644 index 00000000..7a0fb0fe --- /dev/null +++ b/modules/NOS/Devices/Network/Loopback.Class.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #Loopback category: 'SqueakNOS-Net-Devices'! +InternalNetworkDevice subclass: #Loopback + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Devices'! +!Loopback methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + mtu := 1536 +! ! + +!Loopback methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +input: aPacket + self triggerEvent: #input: with: aPacket +! ! + +!Loopback methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +output: aPacket + ^ self input: aPacket +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Loopback class' category: 'SqueakNOS-Net-Devices'! +Loopback class + instanceVariableNames: ''! + + +Loopback initialize! + diff --git a/modules/NOS/Devices/Network/NetworkingDevice.Class.st b/modules/NOS/Devices/Network/NetworkingDevice.Class.st new file mode 100644 index 00000000..bf88dcab --- /dev/null +++ b/modules/NOS/Devices/Network/NetworkingDevice.Class.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #NetworkingDevice category: 'SqueakNOS-Devices-Network'! +PCIDevice subclass: #NetworkingDevice + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Network'! +!NetworkingDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +down +! ! + +!NetworkingDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +input: pkt + "a packet coming from media" + self triggerEvent: #input: with: pkt. + +! ! + +!NetworkingDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +mtu + " 1536 - 4 (for Ethernet CRC)" + ^ 1532 +! ! + +!NetworkingDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +output: aPacket + ^ self sendNow: aPacket +! ! + +!NetworkingDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +up +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NetworkingDevice class' category: 'SqueakNOS-Devices-Network'! +NetworkingDevice class + instanceVariableNames: ''! + +!NetworkingDevice class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +onPCIEntry: aPCIBusEntry computer: aComputer + | answer | + answer := super onPCIEntry: aPCIBusEntry computer: aComputer. + aComputer defaultNetworkInterface: answer. + ^answer +! ! + + diff --git a/modules/NOS/Devices/Network/PacketCapturerFile.Class.st b/modules/NOS/Devices/Network/PacketCapturerFile.Class.st new file mode 100644 index 00000000..10a265a4 --- /dev/null +++ b/modules/NOS/Devices/Network/PacketCapturerFile.Class.st @@ -0,0 +1,73 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PacketCapturerFile category: 'SqueakNOS-Net-Devices'! +InternalNetworkDevice subclass: #PacketCapturerFile + instanceVariableNames: 'stream packetClass' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Devices'! +!PacketCapturerFile commentStamp: '' prior: 0! + +(self onFileNamed: '../ssh-amadeus.tcpdump') +! + +!PacketCapturerFile methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +atEnd + ^ stream atEnd +! ! + +!PacketCapturerFile methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +close + stream close +! ! + +!PacketCapturerFile methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + packetClass := EthernetPacket +! ! + +!PacketCapturerFile methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextPacket + | hdr packetLength capLen | + hdr := stream next: 16. + capLen := hdr unsignedLongAt: 9 bigEndian: false. + packetLength := hdr unsignedLongAt: 13 bigEndian: false. + ^ packetClass bytes: (stream next: capLen) +! ! + +!PacketCapturerFile methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +output: ignore + ^ self +! ! + +!PacketCapturerFile methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +packetClass: aClass + packetClass := aClass +! ! + +!PacketCapturerFile methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +run + [self input: self nextPacket] repeat +! ! + +!PacketCapturerFile methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +stream: aStream + stream := aStream binary. + stream skip: 24 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PacketCapturerFile class' category: 'SqueakNOS-Net-Devices'! +PacketCapturerFile class + instanceVariableNames: ''! + +!PacketCapturerFile class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +fileNamed: filename + ^ self new stream: (FileStream readOnlyFileNamed: filename) +! ! + + +PacketCapturerFile initialize! + diff --git a/modules/NOS/Devices/Network/PacketSocket.Class.st b/modules/NOS/Devices/Network/PacketSocket.Class.st new file mode 100644 index 00000000..fa771a62 --- /dev/null +++ b/modules/NOS/Devices/Network/PacketSocket.Class.st @@ -0,0 +1,166 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PacketSocket category: 'SqueakNOS-Net-Devices'! +InternalNetworkDevice subclass: #PacketSocket + instanceVariableNames: 'adapter packetClass filter promiscuous snapshot semaphore descriptor' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Devices'! +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +adapter + ^ adapter +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +adapter: aString + self mustBeClosed. + adapter := aString +! ! + +!PacketSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:24'! +close + [self primitiveClose: descriptor] on: Error do: [:ex| Transcript cr; show: 'PacketSocket close failed']. + Smalltalk unregisterExternalObject: semaphore +! ! + +!PacketSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:24'! +down + super down. + self close +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +filter + ^ filter +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +filter: aString + filter := aString. + descriptor isNil ifFalse: [self primitiveSet: descriptor filter: filter] +! ! + +!PacketSocket methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + adapter := 'eth0'. + filter := ''. + promiscuous := true. + snapshot := 1500. + mtu := snapshot. + packetClass := EthernetPacket. + semaphore := Semaphore new +! ! + +!PacketSocket methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +mustBeClosed + descriptor isNil ifFalse: [^ self error: 'Socket must be closed'] +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +next + | length bytes | + descriptor isNil ifTrue: [^ self error: 'The socket is closed']. + semaphore wait. + bytes := ByteArray new: snapshot+100. + length := self primitiveRead: descriptor into: bytes startingAt: 1. + ^ packetClass bytes: (bytes copyFrom: 1 to: length) +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextPut: aPacket + self primitiveWrite: descriptor from: aPacket bytes startingAt: aPacket offset + 1 count: aPacket size. + ^ aPacket +! ! + +!PacketSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:24'! +open + | semaphoreIndex | + self mustBeClosed. + semaphoreIndex := Smalltalk registerExternalObject: semaphore. + descriptor := self primitiveOpen: adapter snapshot: snapshot promiscuous: promiscuous semaphore: semaphoreIndex. + self primitiveSet: descriptor filter: filter +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +packetClass + ^ packetClass +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +packetClass: aClass + packetClass := aClass +! ! + +!PacketSocket methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primitiveClose: anInteger + + ^ self primitiveFailed +! ! + +!PacketSocket methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primitiveOpen: deviceName snapshot: anInteger promiscuous: aBoolean semaphore: aSemaphoreIndex + + ^ self primitiveFailed +! ! + +!PacketSocket methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primitiveRead: anInteger into: aByteArray startingAt: startIndex + + ^ self primitiveFailed +! ! + +!PacketSocket methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primitiveSet: anInteger filter: aString + + ^ self primitiveFailed +! ! + +!PacketSocket methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primitiveWrite: anInteger from: aByteArray startingAt: start count: length + + ^ self primitiveFailed +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +promiscuous + ^ promiscuous +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +promiscuous: aBoolean + self mustBeClosed. + promiscuous := aBoolean +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +snapshot + ^ snapshot +! ! + +!PacketSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +snapshot: anInteger + self mustBeClosed. + snapshot := anInteger +! ! + +!PacketSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:24'! +up + super up. + self open +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PacketSocket class' category: 'SqueakNOS-Net-Devices'! +PacketSocket class + instanceVariableNames: ''! + +!PacketSocket class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +new + ^ super new initialize +! ! + + +PacketSocket initialize! + diff --git a/modules/NOS/Devices/Network/PacketSocketPlugin.Class.st b/modules/NOS/Devices/Network/PacketSocketPlugin.Class.st new file mode 100644 index 00000000..d1b11137 --- /dev/null +++ b/modules/NOS/Devices/Network/PacketSocketPlugin.Class.st @@ -0,0 +1,54 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PacketSocketPlugin category: 'SqueakNOS-Net-Devices'! +Object subclass: #PacketSocketPlugin + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Devices'! +!PacketSocketPlugin methodsFor: 'primitive' stamp: 'KenD 28/Jun/2026 13:32:24'! +primitiveClose: descriptor + self primitive: 'PacketSocketClose' parameters: #(SmallInteger). + self cCode: 'sqPacketSocketClose(descriptor)' +! ! + +!PacketSocketPlugin methodsFor: 'primitive' stamp: 'KenD 28/Jun/2026 13:32:24'! +primitiveOpen: deviceName snapshot: anInteger promiscuous: aBoolean semaphoreIndex: semIndex + | stringSize descriptor | + self primitive: 'PacketSocketOpen' parameters: #(String SmallInteger Boolean SmallInteger). + stringSize _ interpreterProxy slotSizeOf: (deviceName asOop: String). + descriptor _ self cCode: 'sqPacketSocketOpen(deviceName, stringSize, anInteger, aBoolean, semIndex)'. + ^ descriptor asSmallIntegerObj +! ! + +!PacketSocketPlugin methodsFor: 'primitive' stamp: 'KenD 28/Jun/2026 13:32:24'! +primitiveRead: descriptor into: aByteArray startingAt: startIndex + "Read next packet into aByteArray and answer its length." + | bufferSize bytesRead | + self primitive: 'PacketSocketRead' parameters: #(SmallInteger ByteArray SmallInteger). + bufferSize _ interpreterProxy slotSizeOf: (aByteArray asOop: ByteArray). + bytesRead _ self cCode: 'sqPacketSocketRead(descriptor, aByteArray, startIndex, bufferSize)'. + ^ bytesRead asSmallIntegerObj +! ! + +!PacketSocketPlugin methodsFor: 'primitive' stamp: 'KenD 28/Jun/2026 13:32:24'! +primitiveSet: descriptor filter: aString + | stringSize | + self primitive: 'PacketSocketSetFilter' parameters: #(SmallInteger String). + stringSize _ interpreterProxy slotSizeOf: (aString asOop: String). + self cCode: 'sqPacketSocketSetFilter(descriptor, aString, stringSize)' +! ! + +!PacketSocketPlugin methodsFor: 'primitive' stamp: 'KenD 28/Jun/2026 13:32:24'! +primitiveWrite: descriptor from: aByteArray startingAt: startIndex count: count + self primitive: 'PacketSocketWrite' parameters: #(SmallInteger ByteArray SmallInteger SmallInteger). + self cCode: 'sqPacketSocketWrite(descriptor, aByteArray, startIndex, count)' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PacketSocketPlugin class' category: 'SqueakNOS-Net-Devices'! +PacketSocketPlugin class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Devices/Network/Realtek8139PCIDevice.Class.st b/modules/NOS/Devices/Network/Realtek8139PCIDevice.Class.st new file mode 100644 index 00000000..5335c547 --- /dev/null +++ b/modules/NOS/Devices/Network/Realtek8139PCIDevice.Class.st @@ -0,0 +1,341 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #Realtek8139PCIDevice category: 'SqueakNOS-Devices-Network'! +NetworkingDevice subclass: #Realtek8139PCIDevice + instanceVariableNames: 'nextTxIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Network'! +!Realtek8139PCIDevice commentStamp: '' prior: 0! + +Realtek offers somehow good information + +http://www.realtek.com.tw/downloads/downloads1-1.aspx?lineid=1 + +self installOn: Computer current +! + +!Realtek8139PCIDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +command + "This register is used for issuing commands to the RTL8139C(L). + These commands are issued by setting the corresponding bits for + the function. A global software reset along with individual reset + and enable/disable for transmitter and receiver are provided here." + ^ self byteAt: 16r37 +! ! + +!Realtek8139PCIDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +command: aByte + ^ self byteAt: 16r37 put: aByte +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +earlyReceiveByteCount + ^ self shortAt: 16r34 +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +earlyReceiveStatus + ^ self byteAt: 16r36 +! ! + +!Realtek8139PCIDevice methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleIRQ + | statusOnEntry | + statusOnEntry := self interruptStatus. + "Status contents: self statusString." "Status := TextMorph new openInWorld" + [ self receiveInterruptPending ifTrue: [self handleReceiveInterrupt]. + self receiveBufferOverflowInterruptPending ifTrue: [self handleReceiveBufferFull]. + ] ifError: [:ex | Transcript show: ex; cr; flush]. + + "reset every interrupt, as they where on entry to avoid race conditions" + self interruptStatus: statusOnEntry. +! ! + +!Realtek8139PCIDevice methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleReceiveInterrupt + | rbuf status len | + [self hasReceiveBufferEmpty] whileFalse: [ + rbuf := self receiveReadAddress. + status := rbuf unsignedShortAt: 1. + len := rbuf unsignedShortAt: 3. + (status anyMask: 1) ifTrue: [ "received OK" + self input: + (EthernetPacket bytes: (rbuf stringAt: 5 size: len - 4))]. "The length includes Ethernet CRC" + + "+4 for PacketHeader, wrap around and align to 4" + len := self receiveReadOffset + len + 4 + 3 bitAnd: 16rFFFC. + self receiveReadOffset: len.] + +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasReceiveBufferEmpty + ^ self command anyMask: 1 +! ! + +!Realtek8139PCIDevice methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + | rbuf | + 0 to: 3 do: [:i | + self transmitStartAddress: i put: (ExternalAddress allocate: 1536 aligned: 4). + self transmitStatus: i put: 2r10000000000000 "belogning to host, don't send"]. + + rbuf := ExternalAddress allocate: 64*1024+16 aligned: 4. + nextTxIndex := 0. + self + reset; + receiveBufferAddress: rbuf; + receiveReadOffset: 16rFFF0; + interruptMask: 2r1110000001111111; "enable all IRQs. needed because the status must be cleared" + command: 12; "enable receive, enable transmit" + receiveConfiguration: 2r1111111001011110; "receive everything except non-matching MAC" + transmitConfiguration: 2r00000011000000000000011011110000. +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptMask + "IMR - Interrupt Mask Register" + ^ self shortAt: 16r3C +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptMask: aShort + ^ self shortAt: 16r3C put: aShort +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptStatus + "ISR - Interrupt Status Register" + ^ self shortAt: 16r3E +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptStatus: aShort + ^ self shortAt: 16r3E put: aShort +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptStatusBit: index + ^ self interruptStatus anyMask: 1 << index +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +logicalAddressFilter + ^ (self longAt: 16rC) << 32 + (self longAt: 8) +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +logicalAddressFilter: anInteger + self longAt: 16rC put: anInteger // 16r100000000. + ^ self longAt: 8 put: anInteger \\ 16r100000000 +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +macAddress + | answer | + answer := self shortAt: 4. + answer := answer << 32 + (self longAt: 0). + ^ EthernetAddress fromInteger: answer + +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +missedPacketCounter + "MPC - Missed Packet Counter: Indicates the number of packets discarded + due to rx FIFO overflow. It is a 24-bit counter. After s/w reset, MPC is + cleared. Only the lower 3 bytes are valid. When any value is written, + MPC will be reset." + ^ self longAt: 16r4C + +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +missedPacketCounterReset + ^ self longAt: 16r4C put: 0 + +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveBuffer + ^ ExternalAddress new fromInteger: self receiveBufferAddress +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveBufferAddress + "RBSTART" + ^ self longAt: 16r30 +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveBufferAddress: anExternalAddressOrInteger + ^ self longAt: 16r30 put: anExternalAddressOrInteger asInteger +! ! + +!Realtek8139PCIDevice methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveBufferOverflowInterruptPending + ^ self interruptStatusBit: 4 +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveConfiguration + "RCR - Receive Configuration Register" + ^ self longAt: 16r44 +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveConfiguration: aLong + ^ self longAt: 16r44 put: aLong +! ! + +!Realtek8139PCIDevice methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveInterruptPending + ^ self interruptStatusBit: 0 +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveReadAddress + ^ ExternalAddress new fromInteger: self receiveReadOffset + 16r10 \\ 16r10000 + self receiveBufferAddress +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveReadOffset + "CAPR - Current Address of Packet Read. + The initial value is 0FFF0h" + ^ self shortAt: 16r38 +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveReadOffset: aShort + ^ self shortAt: 16r38 put: aShort +! ! + +!Realtek8139PCIDevice methodsFor: 'receiving' stamp: 'KenD 28/Jun/2026 13:32:24'! +receiveWriteOffset + "CBA - Current Buffer Address + The initial value is 0000h. It reflect total received byte-count in the rx buffer." + ^ self shortAt: 16r3A +! ! + +!Realtek8139PCIDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +reset + "Reset: Setting to 1 forces the RTL8139C(L) to a software reset state + which disables the transmitter and receiver, reinitializes the FIFOs, + resets the system buffer pointer to the initial value (Tx buffer is at + TSAD0, Rx buffer is empty). The values of IDR0-5 and MAR0-7 and + PCI configuration space will have no changes. This bit is 1 during the + reset operation, and is cleared to 0 by the RTL8139C(L) when the reset + operation is complete." + + self command: 128. + [self command anyMask: 128] whileTrue. +! ! + +!Realtek8139PCIDevice methodsFor: 'transmiting' stamp: 'KenD 28/Jun/2026 13:32:24'! +sendNow: anEthernetPacket + | oldTxIndex | + nextTxIndex := (oldTxIndex := nextTxIndex) + 1 \\ 4. "race condition here if two threads want to do this" + ^ self sendNow: anEthernetPacket on: oldTxIndex. +! ! + +!Realtek8139PCIDevice methodsFor: 'transmiting' stamp: 'KenD 28/Jun/2026 13:32:24'! +sendNow: anEthernetPacket on: descriptorIndex + | str | + str := anEthernetPacket asString padRightTo: 60. + (self transmitStartAddress: descriptorIndex) stringAt: 1 put: str. + self transmitStatus: descriptorIndex put: str size. +! ! + +!Realtek8139PCIDevice methodsFor: 'transmiting' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusString + ^ String streamContents: [:strm | + Time now printOn: strm. + strm nextPutAll: ' IRQ:'. + self interruptStatus printOn: strm base: 16. + strm nextPutAll: ' Tx0:'. + (self transmitStatus: 0) printOn: strm base: 16. + strm nextPutAll: ' Tx1:'. + (self transmitStatus: 1) printOn: strm base: 16. + strm nextPutAll: ' Tx2:'. + (self transmitStatus: 2) printOn: strm base: 16. + strm nextPutAll: ' Tx3:'. + (self transmitStatus: 3) printOn: strm base: 16] + +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +timerCount + "TCTR - Timer Count Register: This register contains a 32-bit + general-purpose timer. Writing any value to this 32-bit register will + reset the original timer and begin to count from zero." + ^ self longAt: 16r48 + +! ! + +!Realtek8139PCIDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +timerCountReset + ^ self longAt: 16r48 put: 0 + +! ! + +!Realtek8139PCIDevice methodsFor: 'transmiting' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitConfiguration + "TCR - Transmit Configuration Register" + ^ self longAt: 16r40 +! ! + +!Realtek8139PCIDevice methodsFor: 'transmiting' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitConfiguration: aLong + ^ self longAt: 16r40 put: aLong +! ! + +!Realtek8139PCIDevice methodsFor: 'transmiting' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitStartAddress: index + ^ ExternalAddress new fromInteger: (self longAt: index*4+16r20) +! ! + +!Realtek8139PCIDevice methodsFor: 'transmiting' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitStartAddress: index put: address + ^ self longAt: index*4+16r20 put: address asInteger +! ! + +!Realtek8139PCIDevice methodsFor: 'transmiting' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitStatus: index + "The read-only bits (CRS, TABT, OWC, CDH, NCC3-0, TOK, TUN) will be cleared + by the RTL8139C(L) when the Transmit Byte Count (bit12-0) in the corresponding + Tx descriptor is written. It is not affected when software writes to these bits. + These registers are only permitted to write by double-word access. After a software + reset, all bits except the OWN bit are reset to 0" + ^ self longAt: index*4+16r10 +! ! + +!Realtek8139PCIDevice methodsFor: 'transmiting' stamp: 'KenD 28/Jun/2026 13:32:24'! +transmitStatus: index put: value + ^ self longAt: index*4+16r10 put: value +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Realtek8139PCIDevice class' category: 'SqueakNOS-Devices-Network'! +Realtek8139PCIDevice class + instanceVariableNames: ''! + +!Realtek8139PCIDevice class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +deviceId + ^ 16r8139 +! ! + +!Realtek8139PCIDevice class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +onPCIEntry: aPCIBusEntry + ^self atMemoryAddress: aPCIBusEntry allMemoryRanges first key. + +! ! + +!Realtek8139PCIDevice class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +vendorId + ^ 16r10EC +! ! + + +Realtek8139PCIDevice initialize! + diff --git a/modules/NOS/Devices/Network/SLIP.Class.st b/modules/NOS/Devices/Network/SLIP.Class.st new file mode 100644 index 00000000..181943c8 --- /dev/null +++ b/modules/NOS/Devices/Network/SLIP.Class.st @@ -0,0 +1,54 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #SLIP category: 'SqueakNOS-Net-Devices'! +InternalNetworkDevice subclass: #SLIP + instanceVariableNames: 'stream' + classVariableNames: 'END ESC ESCEND ESCESC' + poolDictionaries: '' + category: 'SqueakNOS-Net-Devices'! +!SLIP commentStamp: '' prior: 0! + +To start a SLIP on a normal Squeak in Linux: + +1. inside Squeak inspect "SLIP on: (FileStream oldFileNamed: '/dev/ptya0')" +2. open a shell as root +3. be sure that slip is installed in current kernel. check 'dmesg' and/or 'lsmod' output. If it's not, 'insmod slip' should be enough. +4. in the shell: 'slattach -m -L -p slip ttya0 &' +5. in the shell: 'ifconfig sl0 192.168.217.2' "the IP address must be in an unused network" +6. in the shell: 'route add -net 192.168.217.0 netmask 255.255.255.0 sl0' + +! + +!SLIP methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:24'! +close + stream close +! ! + +!SLIP methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + mtu := 296 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SLIP class' category: 'SqueakNOS-Net-Devices'! +SLIP class + instanceVariableNames: 'END ESC ESCEND ESCESC'! + +!SLIP class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + END := Character value: 8r300. + ESC := Character value: 8r333. + ESCEND := Character value: 8r334. + ESCESC := Character value: 8r335. +! ! + +!SLIP class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +on: aStream + ^ self new stream: aStream +! ! + + +SLIP initialize! + diff --git a/modules/NOS/Devices/PC/CMOS.Class.st b/modules/NOS/Devices/PC/CMOS.Class.st new file mode 100644 index 00000000..e00b264f --- /dev/null +++ b/modules/NOS/Devices/PC/CMOS.Class.st @@ -0,0 +1,327 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #CMOS category: 'SqueakNOS-Devices-Base'! +HardwareDevice subclass: #CMOS + instanceVariableNames: 'computer alarmBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Base'! +!CMOS commentStamp: '' prior: 0! + +Information on CMOS: + +DS14285/DS14287 Real-Time Clock with NV RAM Control Control (PDF datasheet) +http://www.maxim-ic.com/getds.cfm?qv_pk=2717 + +Ralph's Brown CMOS and ports description (From his Interrupt List) +http://oopweb.com/Assembly/Documents/InterList/VolumeFrames.html + +BiosCentral. CMOS memory map, no more information than the map +http://www.bioscentral.com/misc/cmosmap.htm + +CMOS RAM Bank 0. Some more information on different RTC IRQs handling +http://ps-2.kev009.com:8080/ohlandl/config/cmos_bank_0.html + +! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +alarm + ^ Time + hour: self alarmHour + minute: self alarmMinute + second: self alarmSecond +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +alarm: aTime + self alarmHour: aTime hour; + alarmMinute: aTime minute; + alarmSecond: aTime second +! ! + +!CMOS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +alarmBlock + ^ alarmBlock +! ! + +!CMOS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +alarmBlock: aBlock + alarmBlock := aBlock +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +alarmHour + ^ self valueAt: 5 +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +alarmHour: aNumber + ^ self valueAt: 5 put: aNumber +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +alarmMinute + ^ self valueAt: 3 +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +alarmMinute: aNumber + ^ self valueAt: 3 put: aNumber +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +alarmSecond + ^ self valueAt: 1 +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +alarmSecond: aNumber + ^ self valueAt: 1 put: aNumber +! ! + +!CMOS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: index + self byteAt: 0 put: index. + ^ self byteAt: 1 +! ! + +!CMOS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: index put: value + self byteAt: 0 put: index. + ^ self byteAt: 1 put: value +! ! + +!CMOS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +bcdAt: index + | value | + value := self at: index. + ^ value // 16 * 10 + (value \\ 16) +! ! + +!CMOS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +bcdAt: index put: value + ^ self at: index put: value // 10 * 16 + (value \\ 10) +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +century + ^ self valueAt: 16r32 +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +century: aNumber + ^ self valueAt: 16r32 put: aNumber +! ! + +!CMOS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +computer + ^ computer +! ! + +!CMOS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +computer: aComputer + computer := aComputer +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +date + ^ Date + newDay: self day + month: self month + year: self year +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +date: aDate + self day: aDate day; + month: aDate month; + year: aDate year +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +day + ^ self valueAt: 7 +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +day: aNumber + ^ self valueAt: 7 put: aNumber +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +dayOfWeek + ^ self at: 6 +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +dayOfWeek: aNumber + ^ self at: 6 put: aNumber +! ! + +!CMOS methodsFor: 'status' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableAlarm + self statusB: (self statusB bitAnd: 16rDF) +! ! + +!CMOS methodsFor: 'status' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableAlarm + self statusB: (self statusB bitOr: 16r20) +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleIRQ + | flags | + flags := self statusC. + (flags anyMask: 16r20) ifTrue: [ + "registerC must be read to clear the interrupt bits, + otherwise, the interrupt is generated again" + self alarmBlock value. + ]. + self uninstallAlarm. +! ! + +!CMOS methodsFor: 'time' stamp: 'KenD 28/Jun/2026 13:32:24'! +hour + ^ self valueAt: 4 +! ! + +!CMOS methodsFor: 'time' stamp: 'KenD 28/Jun/2026 13:32:24'! +hour: aNumber + ^ self valueAt: 4 put: aNumber +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +installAlarm + self computer interruptController addHandler: self forIRQ: 8. + self enableAlarm. +! ! + +!CMOS methodsFor: 'status' stamp: 'KenD 28/Jun/2026 13:32:24'! +isBCD + ^ (self statusB anyMask: 4) not +! ! + +!CMOS methodsFor: 'time' stamp: 'KenD 28/Jun/2026 13:32:24'! +minute + ^ self valueAt: 2 +! ! + +!CMOS methodsFor: 'time' stamp: 'KenD 28/Jun/2026 13:32:24'! +minute: aNumber + ^ self valueAt: 2 put: aNumber +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +month + ^ self valueAt: 8 +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +month: aNumber + ^ self valueAt: 8 put: aNumber +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +onAlarmDo: aBlock + self alarmBlock: aBlock. + +! ! + +!CMOS methodsFor: 'time' stamp: 'KenD 28/Jun/2026 13:32:24'! +second + ^ (self valueAt: 0) + bitAnd: 127 +! ! + +!CMOS methodsFor: 'time' stamp: 'KenD 28/Jun/2026 13:32:24'! +second: aNumber + ^ self valueAt: 0 put: aNumber +! ! + +!CMOS methodsFor: 'status' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusA + ^ self at: 10 +! ! + +!CMOS methodsFor: 'status' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusA: value + ^ self at: 10 put: value +! ! + +!CMOS methodsFor: 'status' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusB + ^ self at: 11 +! ! + +!CMOS methodsFor: 'status' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusB: value + ^ self at: 11 put: value +! ! + +!CMOS methodsFor: 'status' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusC + ^ self at: 16rC +! ! + +!CMOS methodsFor: 'time' stamp: 'KenD 28/Jun/2026 13:32:24'! +time + ^ Time + hour: self hour + minute: self minute + second: self second +! ! + +!CMOS methodsFor: 'time' stamp: 'KenD 28/Jun/2026 13:32:24'! +time: aTime + self hour: aTime hour; + minute: aTime minute; + second: aTime second +! ! + +!CMOS methodsFor: 'alarm' stamp: 'KenD 28/Jun/2026 13:32:24'! +uninstallAlarm + self computer interruptController removeHandler: self forIRQ: 8. + self disableAlarm. +! ! + +!CMOS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +valueAt: index + ^ self isBCD + ifTrue: [self bcdAt: index] + ifFalse: [self at: index] +! ! + +!CMOS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +valueAt: index put: value + ^ self isBCD + ifTrue: [self bcdAt: index put: value] + ifFalse: [self at: index put: value] +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +year + | year | + year := self valueAt: 9. + ^ self century * 100 + year +! ! + +!CMOS methodsFor: 'date' stamp: 'KenD 28/Jun/2026 13:32:24'! +year: aNumber + self valueAt: 9 put: aNumber \\ 100. + self century: aNumber // 100. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CMOS class' category: 'SqueakNOS-Devices-Base'! +CMOS class + instanceVariableNames: ''! + +!CMOS class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + ^ aComputer + cmos: ((self onPort: 112) + computer: aComputer) +! ! + + diff --git a/modules/NOS/Devices/PC/OldPCKeyboard.Class.st b/modules/NOS/Devices/PC/OldPCKeyboard.Class.st new file mode 100644 index 00000000..465efbb5 --- /dev/null +++ b/modules/NOS/Devices/PC/OldPCKeyboard.Class.st @@ -0,0 +1,721 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #OldPCKeyboard category: 'SqueakNOS-Devices-Base'! +HardwareDevice subclass: #OldPCKeyboard + instanceVariableNames: 'pressedKeys replyExpected lastScanCode status buttonsState mousePoint mouseCount prevScanCode underCursorForm event' + classVariableNames: 'ShiftedTranslationTable TranslationTable' + poolDictionaries: 'EventSensorConstants' + category: 'SqueakNOS-Devices-Base'! +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +ackReceived + ^ lastScanCode = 16rFA +! ! + +!OldPCKeyboard methodsFor: 'ports' stamp: 'KenD 28/Jun/2026 13:32:24'! +acknowledge + | read | + read := self acknowledgePort. + self acknowledgePort: (read bitOr: 16r80). + self acknowledgePort: read +! ! + +!OldPCKeyboard methodsFor: 'ports' stamp: 'KenD 28/Jun/2026 13:32:24'! +acknowledgePort + ^ self byteAt: 1 +! ! + +!OldPCKeyboard methodsFor: 'ports' stamp: 'KenD 28/Jun/2026 13:32:24'! +acknowledgePort: aByte + ^ self byteAt: 1 put: aByte +! ! + +!OldPCKeyboard methodsFor: 'mouse access' stamp: 'KenD 28/Jun/2026 13:32:24'! +anyButtonPressed + "Answer whether a mouse button is being pressed." + + ^self buttons > 0 +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +anyModifierKeyPressed + ^ self commandKeyPressed | self controlKeyPressed | self macOptionKeyPressed +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +auxEnable + self controllerCommand: 16rA8 +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +auxEnableDevice + self auxWriteAndWaitAck: 16rF4. +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +auxOutputBufferFull + ^ status anyMask: 16r20 +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +auxSelfTest + self controllerCommand: 16rA9. + ^ self waitData = 0 +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +auxWrite: aByte + self controllerCommand: 16rD4 data: aByte +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +auxWriteAndWaitAck: aByte + self auxWrite: aByte. + ^self waitData = 16rFA +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +auxWriteToOutBuffer: aByte + self controllerCommand: 16rD3 data: aByte +! ! + +!OldPCKeyboard methodsFor: 'mouse access' stamp: 'KenD 28/Jun/2026 13:32:24'! +blueButtonPressed + "Answer whether only the blue mouse button is being pressed. This is the third mouse button or cmd+click on the Mac." + + ^self buttons = 1 +! ! + +!OldPCKeyboard methodsFor: 'mouse access' stamp: 'KenD 28/Jun/2026 13:32:24'! +buttons + + ^ buttonsState bitAnd: 7 +! ! + +!OldPCKeyboard methodsFor: 'ports' stamp: 'KenD 28/Jun/2026 13:32:24'! +byteAt: index + | r | + r := super byteAt: index. +" self report: ' at: ', index printString, ' -> ', r hex. +" ^ r +! ! + +!OldPCKeyboard methodsFor: 'ports' stamp: 'KenD 28/Jun/2026 13:32:24'! +byteAt: index put: value +" self report: ' at: ', index printString, ' <- ', value hex. +" ^ super byteAt: index put: value +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +checkError + ^ self parityError | self timeout +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +checkUserInterrupt: key + | answer | + answer := self commandKeyPressed and: [key = $.]. + answer ifTrue: [Sensor signalUserInterrupt]. + ^answer +! ! + +!OldPCKeyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearInput + 100 timesRepeat: [self readData ifNil: [^ self]] +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +commandKeyPressed + ^ buttonsState anyMask: 16r40 +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +controlKeyPressed + ^ buttonsState anyMask: 16r10 +! ! + +!OldPCKeyboard methodsFor: 'ports' stamp: 'KenD 28/Jun/2026 13:32:24'! +controllerCommand: aByte + ^ self byteAt: 4 put: aByte +! ! + +!OldPCKeyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +controllerCommand: cmd data: aByte + self controllerCommand: cmd. + self safeDelay. + self dataPort: aByte +! ! + +!OldPCKeyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +controllerSelfTest + self controllerCommand: 16rAA. + ^ self waitData = 16r55 +! ! + +!OldPCKeyboard methodsFor: 'ports' stamp: 'KenD 28/Jun/2026 13:32:24'! +controllerStatus + ^ self byteAt: 4 +! ! + +!OldPCKeyboard methodsFor: 'mouse access' stamp: 'KenD 28/Jun/2026 13:32:24'! +cursorPoint: aPoint + self hideCursor. + self mousePoint: aPoint. + self showCursor. + +! ! + +!OldPCKeyboard methodsFor: 'ports' stamp: 'KenD 28/Jun/2026 13:32:24'! +dataPort + ^ self byteAt: 0 +! ! + +!OldPCKeyboard methodsFor: 'ports' stamp: 'KenD 28/Jun/2026 13:32:24'! +dataPort: aByte + ^ self byteAt: 0 put: aByte +! ! + +!OldPCKeyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableScanning + ^ self keyboardCommand: 16rF5 +! ! + +!OldPCKeyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableKeyboard + self controllerCommand: 16rAE + +! ! + +!OldPCKeyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableScanning + ^ self keyboardCommand: 16rF4. + +! ! + +!OldPCKeyboard methodsFor: 'translation' stamp: 'KenD 28/Jun/2026 13:32:24'! +extendedTranslation: scanCode + scanCode = 75 ifTrue: [^Character value: 28]. + scanCode = 77 ifTrue: [^Character value: 29]. + scanCode = 72 ifTrue: [^Character value: 30]. + scanCode = 80 ifTrue: [^Character value: 31]. + scanCode = 71 ifTrue: [^Character value: 1]. + scanCode = 79 ifTrue: [^Character value: 4]. + scanCode = 73 ifTrue: [^Character value: 11]. + scanCode = 81 ifTrue: [^Character value: 12]. + ^ Character value: 0 + +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleIRQ + self report: 'IRQ'. + self handleKbdEvent. + +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleKbdEvent + | count | + count := 1. + self readStatus. + [self outputBufferFull] + whileTrue: + [self nextData. + self checkError + ifFalse: [self auxOutputBufferFull + ifTrue: [self processMouseScanCode: lastScanCode] + ifFalse: [self processScanCode: lastScanCode]]. + count := count + 1. + count = 1000 + ifTrue: + [Transcript cr; show: 'Error de teclado'. + ^ self]. + self readStatus] +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +hideCursor + "underCursorForm ifNotNil: [underCursorForm displayOn: Display at: mousePoint]" + self showCursor +! ! + +!OldPCKeyboard methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializationHandleIRQOn: aComputer +! ! + +!OldPCKeyboard methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + | auxPortPresent | + super initialize. + pressedKeys := SharedQueue new. + event := Array new: 8. + mousePoint := 320 @ 320. + buttonsState := 0. + mouseCount := 2. + prevScanCode := 0. + underCursorForm := nil. + lastScanCode := 0. + self clearInput. + + self setMode: 0. + self initializeHardware. + + (auxPortPresent := true "self isAuxPortPresent") ifTrue: [ + self report: 'Detected PS/2 Mouse port'. + self initializeAux]. + self setInitialMode: auxPortPresent + +! ! + +!OldPCKeyboard methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeAux + self + auxEnable; + mouseSetStandard; + auxEnableDevice +! ! + +!OldPCKeyboard methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeHardware + self report: 'Performing keyboard initialization'. + self controllerSelfTest + ifFalse: + [self report: 'controller self test: failed.'. + ^ false]. + self report: 'controller self test: Ok'. + self keyboardSelfTest + ifFalse: + [self report: 'keyboard self test: failed.'. + ^ false]. + self report: 'keyboard self test: Ok'. + self enableKeyboard. + self report: 'keyboard enabled'. + self resetKeyboard. + self report: 'keyboard reset'. + +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +inputBufferFull + ^ status anyMask: 2 +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isAuxPortPresent + self auxWriteToOutBuffer: 16r5A. + 10 + timesRepeat: + [self readStatus. + self nextData. + self auxOutputBufferFull ifTrue: [^ true]. + (Delay forMilliseconds: 1) wait]. + ^false +! ! + +!OldPCKeyboard methodsFor: 'ports' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardCommand: cmd + + [self dataPort: cmd. + self waitData. + self ackReceived ifTrue: [^ true]. + self resendReceived] whileTrue. + ^ false +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardLocked + ^ (status anyMask: 16r10) not +! ! + +!OldPCKeyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardSelfTest + self controllerCommand: 16rAB. + ^ self waitData = 0 +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +lastWriteCommand + ^ status anyMask: 8 +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +leftShiftDown + ^ self leftShiftPressed +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +leftShiftPressed + ^ buttonsState anyMask: 8 +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +macOptionKeyPressed + ^ false +! ! + +!OldPCKeyboard methodsFor: 'mouse access' stamp: 'KenD 28/Jun/2026 13:32:24'! +mousePoint: aPoint + mousePoint := aPoint adhereTo: Display boundingBox +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +mouseSetStandard + self auxWrite: 16rF6. +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +newKeyboardDownEvent: aCharacter + self newKeyboardEvent: aCharacter type: EventKeyDown. + self newKeyboardEvent: aCharacter type: EventKeyChar. + +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +newKeyboardEvent: aCharacter type: byteType + " taken from EventSensor >> #nextEventSynthesized " + event + at: 1 put: EventTypeKeyboard; "evt type" + at: 2 put: Time millisecondClockValue; "time stamp" + at: 3 put: aCharacter asciiValue; "char code" + at: 4 put: byteType; "key press/release" + at: 5 put: buttonsState >> 3. "modifier keys" + + Sensor processEvent: event. + self report: event. +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +newKeyboardUpEvent: aCharacter + self newKeyboardEvent: aCharacter type: EventKeyUp +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +newMouseEvent + | modifiers buttons mapped | + modifiers := buttonsState bitShift: -3. + buttons := buttonsState bitAnd: 7. + mapped := Sensor mapButtons: buttons modifiers: modifiers. + event + at: 1 put: EventTypeMouse; + at: 2 put: Time millisecondClockValue; + at: 3 put: mousePoint x; + at: 4 put: mousePoint y; + at: 5 put: mapped; + at: 6 put: modifiers. + Sensor processEvent: event. + self report: event. +! ! + +!OldPCKeyboard methodsFor: 'commands support' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextData + ^ lastScanCode := self dataPort. + +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextKey + ^ pressedKeys next +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +outputBufferFull + ^ status anyMask: 1 +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +parityError + ^ status anyMask: 16r80 +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +peekKey + ^ pressedKeys peek +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +processMouseScanCode: aByte + | scanCode | + scanCode := aByte. + mouseCount := mouseCount + 1. + mouseCount = 1 ifTrue: [ "button state" + buttonsState := (((buttonsState bitClear: 7) + bitOr: (scanCode bitAnd: 2)) + bitOr: (scanCode bitAnd: 1) << 2) + bitOr: (scanCode bitAnd: 4) >> 2.]. + mouseCount = 2 ifTrue: [ "x delta" + scanCode > 127 ifTrue: [scanCode := scanCode - 256]. + self hideCursor. + self mousePoint: scanCode @ 0 + mousePoint]. + mouseCount = 3 ifTrue: [ "y delta" + scanCode > 127 ifTrue: [scanCode := scanCode - 256]. + self mousePoint: mousePoint - (0 @ scanCode). + mouseCount := 0. + self showCursor]. + self newMouseEvent +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +processScanCode: scanCode + | key code | + scanCode = 0 | (scanCode = 16rFF) " extended keys " + ifTrue: + [prevScanCode := 0. + ^ self]. + (scanCode anyMask: 16r80) + ifTrue: "key up" + [scanCode = 16rE0 | (scanCode = 16rE1) " special keys (SysReq) " + ifTrue: + [prevScanCode := scanCode. + ^ self]. + code := scanCode bitClear: 16r80. + (key := self simpleTranslation: code) asciiValue = 0 + ifTrue: [buttonsState := buttonsState bitClear: (self shiftTranslation: code)] + ifFalse: [self newKeyboardUpEvent: key]. + prevScanCode := scanCode. + ^ self] + ifFalse: "key down" + [prevScanCode = 16rE0 + ifTrue: [key := self extendedTranslation: scanCode] + ifFalse: + [key := self shiftPressed + ifTrue: [self shiftedTranslation: scanCode] + ifFalse: [self simpleTranslation: scanCode]. + key asciiValue = 0 + ifTrue: [buttonsState := buttonsState bitOr: (self shiftTranslation: scanCode)]]. + key asciiValue = 0 ifFalse: [self newKeyboardDownEvent: key]. + prevScanCode := 0]. + + +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +rawMacOptionKeyPressed + ^ false +! ! + +!OldPCKeyboard methodsFor: 'commands support' stamp: 'KenD 28/Jun/2026 13:32:24'! +readData + | answer | + self readStatus. + self outputBufferFull ifFalse: [^ nil]. + answer := self nextData. + ^ self checkError + ifTrue: + [Transcript cr; show: 'Error in #readData: ', (status printStringBase: 2). + nil] + ifFalse: [answer] +! ! + +!OldPCKeyboard methodsFor: 'commands support' stamp: 'KenD 28/Jun/2026 13:32:24'! +readStatus + ^ status := self controllerStatus +! ! + +!OldPCKeyboard methodsFor: 'mouse access' stamp: 'KenD 28/Jun/2026 13:32:24'! +redButtonPressed + "Answer true if the red mouse button is being pressed. This is the first mouse button." + + ^self buttons = 4 +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +resendReceived + ^ lastScanCode = 16rFE +! ! + +!OldPCKeyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetKeyboard + ^ self keyboardCommand: 16rFF. + +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +rightShiftPressed + ^ buttonsState anyMask: 8 +! ! + +!OldPCKeyboard methodsFor: 'commands support' stamp: 'KenD 28/Jun/2026 13:32:24'! +safeDelay + 250 + timesRepeat: + [self handleKbdEvent. + self inputBufferFull ifFalse: [^ self]. + (Delay forMilliseconds: 1) wait] +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +setAuxResolution: value + self auxWriteAndWaitAck: 16rE8. + self auxWriteAndWaitAck: value. +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +setAuxSample: value + self auxWriteAndWaitAck: 16rF3. + self auxWriteAndWaitAck: value. +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +setAuxScale11 + self auxWriteAndWaitAck: 16rE6. +! ! + +!OldPCKeyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +setAuxScale21 + self auxWriteAndWaitAck: 16rE7. +! ! + +!OldPCKeyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +setInitialMode: auxPortPresent + #(keyboardGenerateIRQ1 auxGenerateIRQ12 systemFlag disableKeboardInterface disableMouseInterface scanCodeConversionToPCFormat ). + #(1 2 4 16 32 64 ). + self disableScanning. + self setMode: (auxPortPresent ifTrue: [16r47] ifFalse: [16r65]). + self enableScanning + + +! ! + +!OldPCKeyboard methodsFor: 'commands support' stamp: 'KenD 28/Jun/2026 13:32:24'! +setMode: aByte + self controllerCommand: 16r60 data: aByte +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +shiftPressed + ^ self leftShiftPressed or: [self rightShiftPressed] +! ! + +!OldPCKeyboard methodsFor: 'translation' stamp: 'KenD 28/Jun/2026 13:32:24'! +shiftTranslation: scanCode + scanCode = 16r2A & (prevScanCode ~= 16rE0) ifTrue: ["left shift" ^ 8]. + scanCode = 16r36 & (prevScanCode ~= 16rE0) ifTrue: ["right shift" ^ 8]. + scanCode = 16r38 ifTrue: ["left ALT (command key)" ^ 16r40]. + scanCode = 16r1D ifTrue: ["left CTRL" ^ 16r10]. + +" Transcript show: scanCode hex; space." + ^ 0 +! ! + +!OldPCKeyboard methodsFor: 'translation' stamp: 'KenD 28/Jun/2026 13:32:24'! +shiftedTranslation: scanCode + ^ ShiftedTranslationTable at: scanCode + 1 ifAbsent: [Character value: 0] + +! ! + +!OldPCKeyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +showCursor +" underCursorForm := Form fromDisplay: (mousePoint extent: Cursor currentCursor extent). + Cursor currentCursor asCursorForm displayOn: Display at: mousePoint rule: Form reverse. +" +! ! + +!OldPCKeyboard methodsFor: 'translation' stamp: 'KenD 28/Jun/2026 13:32:24'! +simpleTranslation: scanCode + ^ TranslationTable at: scanCode + 1 ifAbsent: [Character value: 0] + + +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +testSuccessful + ^ status anyMask: 4 +! ! + +!OldPCKeyboard methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +timeout + ^ status anyMask: 16r40 +! ! + +!OldPCKeyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitData + | answer | + 2 + timesRepeat: + [(answer := self readData) ifNotNil: [^ answer]. + " (Delay forMilliseconds: 1) wait "]. + Transcript cr; show: ' wait data timedout.'. + ^ nil +! ! + +!OldPCKeyboard methodsFor: 'mouse access' stamp: 'KenD 28/Jun/2026 13:32:24'! +yellowButtonPressed + "Answer whether only the yellow mouse button is being pressed. This is the second mouse button or option+click on the Mac." + + ^self buttons = 2 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OldPCKeyboard class' category: 'SqueakNOS-Devices-Base'! +OldPCKeyboard class + instanceVariableNames: 'ShiftedTranslationTable TranslationTable'! + +!OldPCKeyboard class methodsFor: 'system startup' stamp: 'KenD 28/Jun/2026 13:32:24'! +cCharsToArray: aString + | strm table | + strm := ReadStream on: aString. + strm reset. + table := OrderedCollection new: 128. + [strm atEnd] + whileFalse: [strm peek = $\ + ifTrue: + [strm next. + strm peek isDigit + ifTrue: [table add: (Character value: ('8r' , (strm next: 3)) asNumber)] + ifFalse: [table add: (self unescapeCharacter: strm next)]] + ifFalse: [table add: strm next]]. + ^ table asArray +! ! + +!OldPCKeyboard class methodsFor: 'system startup' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + self initializeTranslationTables +! ! + +!OldPCKeyboard class methodsFor: 'system startup' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeTranslationTables + TranslationTable := self cCharsToArray: + '\000\0331234567890-=\010\t' , + 'qwertyuiop[]\r\000as' , + 'dfghjkl;''`\000\\zxcv' , + 'bnm,./\000*\000 \000\201\202\203\204\205' , + '\206\207\210\211\212\000\000789-456+1' , + '230\177\000\000\213\214\000\000\000\000\000\000\000\000\000\000' , + '\r\000/'. + ShiftedTranslationTable := self cCharsToArray: + '\000\033!!@#$%^&*()_+\010\t' , + 'QWERTYUIOP{}\r\000AS' , + 'DFGHJKL:"~\000|ZXCV' , + 'BNM<>?\000*\000 \000\201\202\203\204\205' , + '\206\207\210\211\212\000\000789-456+1' , + '230\177\000\000\213\214\000\000\000\000\000\000\000\000\000\000' , + '\r\000/'. + +! ! + +!OldPCKeyboard class methodsFor: 'system startup' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + | keyboard | + keyboard := self onPort: 16r60. + aComputer interruptController addHandler: keyboard forIRQ: 1. + aComputer keyboard: keyboard. + aComputer interruptController addHandler: keyboard forIRQ: 12. + HandMorph allInstances do: [:each | + each hasUserInformation ifFalse: [ + each userInitials: ' ' andPicture: each userPicture]]. + Sensor eventTicklerProcess terminate. + ^ aComputer mouse: keyboard. + +! ! + +!OldPCKeyboard class methodsFor: 'system startup' stamp: 'KenD 28/Jun/2026 13:32:24'! +unescapeCharacter: char + char = $t ifTrue: [^ Character tab]. + char = $r ifTrue: [^ Character cr]. + char = $n ifTrue: [^ Character lf]. + ^ char +! ! + + +OldPCKeyboard initialize! + diff --git a/modules/NOS/Devices/PC/PCIBusEntry.Class.st b/modules/NOS/Devices/PC/PCIBusEntry.Class.st new file mode 100644 index 00000000..3502a905 --- /dev/null +++ b/modules/NOS/Devices/PC/PCIBusEntry.Class.st @@ -0,0 +1,1018 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PCIBusEntry category: 'SqueakNOS-Devices-Base'! +HardwareDevice subclass: #PCIBusEntry + instanceVariableNames: 'bus device function' + classVariableNames: 'VendorsAndDevices' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Base'! +!PCIBusEntry commentStamp: '' prior: 0! + +I represent a device 'function' (DF) 'configuration space' (CS) in the PCI bus. (*guessing*) Simple devices have only one function. +In PCI, each DF is assigned an ID, which is used to access its associated CS, through IO ports 0xCF8 and 0xCFC. + +The CS provides 64 bytes of fixed fields that give info about the device: device ID, vendor ID, Status, etc. One very important info the CS give are the 6 Base Address Registers (BARs). The BIOS or OS assigns mmaped addresses or IO ports to the DF, and saves those addresses in the BAR fields of the CS. To obtain those addresses, the driver just reads the BAR fields. Those fields are encoded: if it is an io port, the first bit is 1, and bits 3 to 32 are the base io address (4 byte aligned). Else, if first bit is 0, it is an mmaped address, and bits 5 to 32 tell the base address (16-byte aligned). + +The ID of a DF is split in 8 bit bus number, 5 bit device number and 3 bit function number. + +Some examples: + +"To scan the bus" PCIBusEntry allValid +"To get memory ranges" PCIBusEntry allValid collect: [:e | e allMemoryRanges] +"To get IO ranges" PCIBusEntry allValid collect: [:e | e allIORanges] + +Information on PCIBus + +GRUB Legacy source (GRUB 0.97) netboot/pci.c + +Info from pages: +http://www.mega-tokyo.com/osfaq/Where%20can%20I%20find%20programming%20info%20on%20PCI%3F +http://www.cs.nmsu.edu/~pfeiffer/classes/473/notes/pci.html + +Specs from: +http://perso.orange.fr/pierrelib/buses/index.htm +Specially chapter 6 from PCI Local Bus Specification (v2.2 for example) + +Vendors and device list: +http://www.pcidatabase.com/ + +Class codes and Class sub codes: +http://www.acm.uiuc.edu/sigops/roll_your_own/7.c.1.html +http://cvs.opensolaris.org/source/raw/on/usr/src/common/pci/pci_strings.c + +Still missing in this implementation (may be more things are missing): +- Memory and I/O map support (moving PCI devices around in memory and I/O space) +- Class and subClass code strings (just for readability). +- Capabilities List (chapter 6.7 and Appendix H of PCI Local Bus Spec) +- PCI Exansion ROMs (chapter 6.3 of PCI Local Bus Spec) +- Vital Product Data (Appendix I of PCI Local Bus Spec) +- Message Signaled Interrupts (chapter 6.8 of PCI Local Bus Spec) + +! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +DEVSELtiming + " bits 9,10 - These bits encode the timing of DEVSEL#. Section 3.6.1. of + PCI Local Bus Spec specifies three allowable timings for assertion of DEVSEL#. + These are encoded as 00b for fast, 01b for medium, and 10b for slow (11b is + reserved). These bits are read-only and must indicate the slowest time + that a device asserts DEVSEL# for any bus command except + Configuration Read and Configuration Write." + + ^ self status >> 9 bitAnd: 3 +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +MaxLat + ^ self configByte: 16r3F +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +MinGnt + ^ self configByte: 16r3E +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +allIORanges + | answer addr | + + answer := OrderedCollection new: 6. + 0 to: 5 do: [:i | + addr := self baseAddressRegister: i. + addr even + ifTrue: ["is memory"] + ifFalse: [ + answer add: + (addr bitAnd: 3 bitInvert) -> (self baseIOAddressRegisterSize: i original: addr). + ]]. + + ^ answer +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +allMemoryRanges + | answer addr | + + answer := OrderedCollection new: 6. + 0 to: 5 do: [:i | + addr := self baseAddressRegister: i. + (addr ~= 0 and: [addr even]) + ifTrue: ["is memory" + answer add: + (addr bitAnd: 3 bitInvert) -> (self baseMemoryAddressRegisterSize: i original: addr). + ]]. + + ^ answer +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +baseAddressRegister: index + index > 5 ifTrue: [self errorSubscriptBounds: index]. + ^ self configLong: index * 4 + 16 +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +baseAddressRegister: index put: address + index > 5 ifTrue: [self errorSubscriptBounds: index]. + ^ self configLong: index * 4 + 16 put: address +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +baseAddressRegisterSize: index + | original | + + original := self baseAddressRegister: index. + original even + ifTrue: [^ self baseMemoryAddressRegisterSize: index original: original] + ifFalse: [^ self baseIOAddressRegisterSize: index original: original] + +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +baseIOAddress: index + | addr | + addr := self baseAddressRegister: index. + addr even ifTrue: [^self halt "is memory"]. + ^addr bitAnd: 3 bitInvert + +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +baseIOAddressRegisterSize: index original: original + | enabled answer | + + enabled := self hasIOEnabled. + + self baseAddressRegister: index put: 16rFFFFFFFF. + answer := self baseAddressRegister: index. + self baseAddressRegister: index put: original. + + enabled ifTrue: [self enableIO]. + + (answer noMask: 16rFFFF0000) + ifTrue: [answer := answer + 16rFFFF0000]. + + ^ ((answer bitAnd: 3 bitInvert) bitInvert + 1) bitAnd: 16rFFFFFFFF + +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +baseMemory32AddressRegisterSize: index original: original + | enabled answer | + + enabled := self hasMemoryEnabled. + + self baseAddressRegister: index put: 16rFFFFFFFF. + answer := self baseAddressRegister: index. + self baseAddressRegister: index put: original. + + enabled ifTrue: [self enableMemory]. + + ^ ((answer bitAnd: 15 bitInvert) bitInvert + 1) bitAnd: 16rFFFFFFFF + +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +baseMemory64AddressRegisterSize: index original: originalLo + | enabled answer originalHi | + + enabled := self hasMemoryEnabled. + + originalHi := self baseAddressRegister: index+1. + + self baseAddressRegister: index put: 16rFFFFFFFF. + self baseAddressRegister: index+1 put: 16rFFFFFFFF. + + "from spec it's not clear if reg at index+1 has lower bits correct or not. From testing, apparently it has" + answer := (self baseAddressRegister: index + 1) << 32 + (self baseAddressRegister: index). + + self baseAddressRegister: index put: originalLo. + self baseAddressRegister: index+1 put: originalHi. + + enabled ifTrue: [self enableMemory]. + + ^ ((answer bitAnd: 15 bitInvert) bitInvert + 1) bitAnd: 16rFFFFFFFFFFFFFFFF + +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +baseMemoryAddressRegisterSize: index original: original + | size | + original isZero ifTrue: [^ 0]. + + size := original bitAnd: 2r110. + + size = 2r100 ifTrue: [^ self baseMemory64AddressRegisterSize: index original: original]. + size = 2r110 ifTrue: ["reserved mode" ^ self error: 'Unknown memory model']. + + " can be 2r000 (32 bits) or 2r010 (32 bits < 1Meg) " + ^ self baseMemory32AddressRegisterSize: index original: original. +! ! + +!PCIBusEntry methodsFor: 'accessing - bist' stamp: 'KenD 28/Jun/2026 13:32:24'! +bistCompletionCode + " bits 0-3 - A value of 0 means the device has passed its test. Non-zero values + mean the device failed. Device-specific failure codes can be encoded + in the non-zero value." + ^ self builtInSelfTest bitAnd: 15 +! ! + +!PCIBusEntry methodsFor: 'accessing - bist' stamp: 'KenD 28/Jun/2026 13:32:24'! +bistHasFinished + " bit 6 - Write a 1 to invoke BIST. Device resets the bit when BIST is complete. + Software should fail the device if BIST is not complete after 2 seconds." + + ^ (self builtInSelfTest anyMask: 64) not +! ! + +!PCIBusEntry methodsFor: 'accessing - bist' stamp: 'KenD 28/Jun/2026 13:32:24'! +builtInSelfTest + ^ self configByte: 15 +! ! + +!PCIBusEntry methodsFor: 'accessing - bist' stamp: 'KenD 28/Jun/2026 13:32:24'! +builtInSelfTest: byte + ^ self configByte: 15 put: byte +! ! + +!PCIBusEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +bus: aNumber + bus := aNumber +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +cacheLineSize + ^ self configByte: 12 +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +capabilitiesPointer + ^ self configByte: 16r34 +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +cardbusCISPointer + ^ self configLong: 16r28 +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +classCode + ^ self configByte: 11 +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +classSubCode + ^ self configByte: 10 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +command + ^ self configShort: 4 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +command: aNumber + ^ self configShort: 4 put: aNumber +! ! + +!PCIBusEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +configByte: index + self longAt: 0 put: (self translate: index). + ^ self byteAt: 4 + (index bitAnd: 3) +! ! + +!PCIBusEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +configByte: index put: aNumber + self longAt: 0 put: (self translate: index). + ^ self byteAt: 4 + (index bitAnd: 3) put: aNumber +! ! + +!PCIBusEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +configLong: index + self longAt: 0 put: (self translate: index). + ^ self longAt: 4 +! ! + +!PCIBusEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +configLong: index put: aNumber + self longAt: 0 put: (self translate: index). + ^ self longAt: 4 put: aNumber +! ! + +!PCIBusEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +configShort: index + self longAt: 0 put: (self translate: index). + ^ self shortAt: 4 + (index bitAnd: 2) +! ! + +!PCIBusEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +configShort: index put: aNumber + self longAt: 0 put: (self translate: index). + ^ self shortAt: 4 + (index bitAnd: 2) put: aNumber +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +detectedParityError + " bit 15 - This bit must be set by the device whenever it detects a parity error, + even if parity error handling is disabled (as controlled by bit 6 in the + Command register)." + + ^ self statusBit: 15 +! ! + +!PCIBusEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +device: aNumber + device := aNumber +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +deviceId + ^ self configShort: 2 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableBusMastering + ^ self disableCommandBit: 2 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableCommandBit: bit + ^ self command: (self command bitAnd: 16rFFFF - (1 << bit)) +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableFastBackToBack + ^ self disableCommandBit: 9 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableIO + ^ self disableCommandBit: 0 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableMemory + ^ self disableCommandBit: 1 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableMemoryWriteAndInvalidateEnabled + ^ self disableCommandBit: 4 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableParityErrorGeneration + ^ self disableCommandBit: 6 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableSpecialCycle + ^ self disableCommandBit: 3 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableStepping + ^ self disableCommandBit: 7 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableSystemErrorGeneration + ^ self disableCommandBit: 8 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableVGAPaletteSnooping + ^ self disableCommandBit: 5 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disconnect + ^ self command: 0 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableBusMastering + ^ self enableCommandBit: 2 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCommandBit: bit + ^ self command: (self command bitOr: 1 << bit) +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableFastBackToBack + ^ self enableCommandBit: 9 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableIO + ^ self enableCommandBit: 0 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableMemory + ^ self enableCommandBit: 1 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableMemoryWriteAndInvalidateEnabled + ^ self enableCommandBit: 4 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableParityErrorGeneration + ^ self enableCommandBit: 6 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableSpecialCycle + ^ self enableCommandBit: 3 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableStepping + ^ self enableCommandBit: 7 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableSystemErrorGeneration + ^ self enableCommandBit: 8 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableVGAPaletteSnooping + ^ self enableCommandBit: 5 +! ! + +!PCIBusEntry methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +formatedConfigurationRegisters + ^ '0h - VENDOR ID: ' , self vendorId hex , ' DEV ID: ' , self deviceId hex , String cr + , '4h - COMMAND: ' , self command hex , ' STATUS: ' , self status hex , String cr + , '8h - REV ID: ' , self revisionId hex , ' CLS CODE: ' , self classCode hex + , String cr , 'Ch - CACHE LINE S: ' , self cacheLineSize hex , ' LAT TIMER: ' + , self latencyTimer hex , ' HDR TYPE: ' , self headerType hex , ' BIST: ' + , self builtInSelfTest hex , String cr , '10h - BAR0: ' + , (self baseAddressRegister: 0) hex , String cr , '14h - BAR1: ' + , (self baseAddressRegister: 1) hex , String cr , '18h - BAR2: ' + , (self baseAddressRegister: 2) hex , String cr , '1Ch - BAR3: ' + , (self baseAddressRegister: 3) hex , String cr , '20h - BAR4: ' + , (self baseAddressRegister: 4) hex , String cr , '24h - BAR5: ' + , (self baseAddressRegister: 5) hex , String cr , 'INTR LINE: ' + , self interruptLine printString +! ! + +!PCIBusEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +function: aNumber + function := aNumber +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasBusMasteringEnabled + "bit 2 - Controls a device's ability to act as a master on the PCI bus. A value + of 0 disables the device from generating PCI accesses. A value of 1 + allows the device to behave as a bus master. State after RST# is 0." + + ^ self testCommandBit: 2 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasCapabilitiesList + " bit 4 - This optional read-only bit indicates whether or not this device + implements the pointer for a New Capabilities linked list at offset 34h. + A value of zero indicates that no New Capabilities linked list is + available. A value of one indicates that the value read at offset 34h is a + pointer in Configuration Space to a linked list of new capabilities. Refer + to Section 6.7. of PCI Local Bus Spec for details on New Capabilities." + + ^ self statusBit: 4 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasFastBackToBackEnabled + "bit 9 - This optional read/write bit controls whether or not a master can do + fast back-to-back transactions to different devices. Initialization + software will set the bit if all targets are fast back-to-back capable. A + value of 1 means the master is allowed to generate fast back-to-back + transactions to different agents as described in Section 3.4.2. A value + of 0 means fast back-to-back transactions are only allowed to the + same agent. This bit\u2019s state after RST# is 0." + + ^ self testCommandBit: 9 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasIOEnabled + "bit 0 - Controls a device\u2019s response to I/O Space accesses. A value of 0 + disables the device response. A value of 1 allows the device to + respond to I/O Space accesses. State after RST# is 0." + + ^ self testCommandBit: 0 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasMasterDataParityError + " bit 8 - This bit is only implemented by bus masters. It is set when three + conditions are met: 1) the bus agent asserted PERR# itself (on a read) + or observed PERR# asserted (on a write); 2) the agent setting the bit + acted as the bus master for the operation in which the error occurred; + and 3) the Parity Error Response bit (Command register) is set." + + ^ self statusBit: 8 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasMemoryEnabled + "bit 1 - Controls a device's response to Memory Space accesses. A value of + 0 disables the device response. A value of 1 allows the device to + respond to Memory Space accesses. State after RST# is 0." + + ^ self testCommandBit: 1 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasMemoryWriteAndInvalidateEnabled + "bit 4 - This is an enable bit for using the Memory Write and Invalidate + command. When this bit is 1, masters may generate the command. + When it is 0, Memory Write must be used instead. State after RST# is + 0. This bit must be implemented by master devices that can generate + the Memory Write and Invalidate command." + + ^ self testCommandBit: 4 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasParityErrorGenerationEnabled + "bit 6 - This bit controls the device\u2019s response to parity errors. When the bit is + set, the device must take its normal action when a parity error is + detected. When the bit is 0, the device sets its Detected Parity Error + status bit (bit 15 in the Status register) when an error is detected, but + does not assert PERR# and continues normal operation. This bit\u2019s + state after RST# is 0. Devices that check parity must implement this + bit. Devices are still required to generate parity even if parity checking + is disabled." + + ^ self testCommandBit: 6 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasSpecialCycleEnabled + "bit 3 - Controls a device's action on Special Cycle operations. A value of 0 + causes the device to ignore all Special Cycle operations. A value of 1 + allows the device to monitor Special Cycle operations. State after + RST# is 0." + + ^ self testCommandBit: 3 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasSteppingEnabled + "bit 7 - This bit is used to control whether or not a device does address/data + stepping. Devices that never do stepping must hardwire this bit to 0. + Devices that always do stepping must hardwire this bit to 1. Devices + that can do either, must make this bit read/write and have it initialize to + 1 after RST#." + + ^ self testCommandBit: 7 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasSystemErrorGenerationEnabled + "bit 8 - This bit is used to control whether or not a device does address/data + stepping. Devices that never do stepping must hardwire this bit to 0. + Devices that always do stepping must hardwire this bit to 1. Devices + that can do either, must make this bit read/write and have it initialize to + 1 after RST#. SERR is signaled by hardware for Unrecoverable errors." + + ^ self testCommandBit: 8 +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasVGAPaletteSnoopingEnabled + "bit 5 - This bit controls how VGA compatible and graphics devices handle + accesses to VGA palette registers. When this bit is 1, palette + snooping is enabled (i.e., the device does not respond to palette + register writes and snoops the data). When the bit is 0, the device + should treat palette write accesses like all other accesses. VGA + compatible devices should implement this bit. Refer to Section 3.10. + of PCI Local Bus Spec for more details on VGA palette snooping." + + ^ self testCommandBit: 5 +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +headerType + ^ self configByte: 14 +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptLine + ^ self configByte: 16r3C +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptPin + ^ self configByte: 16r3D +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +is66MHzCapable + " bit 5 - This optional read-only bit indicates whether or not this device is + capable of running at 66 MHz as defined in Chapter 7 of PCI Local Bus Spec. + A value of zero indicates 33 MHz. A value of 1 indicates that the device is 66 MHz + capable." + + ^ self statusBit: 5 +! ! + +!PCIBusEntry methodsFor: 'accessing - bist' stamp: 'KenD 28/Jun/2026 13:32:24'! +isBistCapable + " bit 7 - Return 1 if device supports BIST. Return 0 if the device is not BIST + capable." + + ^ self builtInSelfTest anyMask: 128 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +isFastBackToBackCapable + " bit 7 - This optional read-only bit indicates whether or not the target is + capable of accepting fast back-to-back transactions when the + transactions are not to the same agent. This bit can be set to 1 if the + device can accept these transactions and must be set to 0 otherwise. + Refer to Section 3.4.2. of PCI Local Bus Spec for a complete description + of requirements for setting this bit." + + ^ self statusBit: 7 +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +isMultiFunction + ^ self headerType anyMask: 16r80 +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +isValid + | vendor | + vendor := self vendorId. + ^ vendor ~= 0 and: [vendor ~= 16rFFFF]. +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +latencyTimer + ^ self configByte: 13 +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +latencyTimer: aByte + ^ self configByte: 13 put: aByte +! ! + +!PCIBusEntry methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: strm + strm + nextPutAll: self class name; + nextPut: $:; + space; + nextPutAll: bus printStringHex; + nextPut: $:; + nextPutAll: device printStringHex; + nextPut: $.; + nextPutAll: function printString; + space; + nextPutAll: self stringForVendorAndDevice; + cr; + nextPutAll: self formatedConfigurationRegisters +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +programmingInterface + ^ self configByte: 9 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +receivedMasterAbort + " bit 13 - This bit must be set by a master device whenever its transaction is + terminated with Target-Abort. All master devices must implement this + bit." + + ^ self statusBit: 13 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +receivedTargetAbort + " bit 12 - This bit must be set by a master device whenever its transaction is + terminated with Target-Abort. All master devices must implement this + bit." + + ^ self statusBit: 12 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetDetectedParityError + ^ self resetStatusBit: 15 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetMasterDataParityError + ^ self resetStatusBit: 8 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetReceivedMasterAbort + ^ self resetStatusBit: 13 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetReceivedTargetAbort + ^ self resetStatusBit: 12 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetSignaledSystemError + ^ self resetStatusBit: 14 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetSignaledTargetAbort + ^ self resetStatusBit: 11 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetStatusBit: bit + ^ self status: 1 << bit +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +revisionId + ^ self configByte: 8 +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +romAddressRegister + ^ self configLong: 16r30 +! ! + +!PCIBusEntry methodsFor: 'accessing - addresses map' stamp: 'KenD 28/Jun/2026 13:32:24'! +romAddressRegister: addr + ^ self configLong: 16r30 put: addr +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +signaledSystemError + " bit 14 - This bit must be set whenever the device asserts SERR#. Devices + who will never assert SERR# do not need to implement this bit." + + ^ self statusBit: 14 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +signaledTargetAbort + " bit 11 - This bit must be set by a target device whenever it terminates a + transaction with Target-Abort. Devices that will never signal Target- + Abort do not need to implement this bit." + + ^ self statusBit: 11 +! ! + +!PCIBusEntry methodsFor: 'accessing - bist' stamp: 'KenD 28/Jun/2026 13:32:24'! +startBist + " bit 6 - Write a 1 to invoke BIST. Device resets the bit when BIST is complete. + Software should fail the device if BIST is not complete after 2 seconds." + + ^ self builtInSelfTest: (self builtInSelfTest bitOr: 64) +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +status + ^ self configShort: 6 +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +status: word + ^ self configShort: 6 put: word +! ! + +!PCIBusEntry methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusBit: bit + ^ self status anyMask: 1 << bit +! ! + +!PCIBusEntry methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +stringForVendorAndDevice + ^ self class stringForVendor: self vendorId device: self deviceId +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +subsystemId + ^ self configShort: 16r2E +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +subsystemVendorId + ^ self configShort: 16r2C +! ! + +!PCIBusEntry methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +testCommandBit: bit + ^ self command anyMask: 1 << bit + +! ! + +!PCIBusEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +translate: index + ^ 16r80000000 + (bus << 16) + (device << 11) + (function << 8) + (index bitAnd: 16rFC) + +! ! + +!PCIBusEntry methodsFor: 'accessing - general config' stamp: 'KenD 28/Jun/2026 13:32:24'! +vendorId + ^ self configShort: 0 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PCIBusEntry class' category: 'SqueakNOS-Devices-Base'! +PCIBusEntry class + instanceVariableNames: 'VendorsAndDevices'! + +!PCIBusEntry class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +allValid + " PCIDevice allValid " + | answer scanner | + answer := OrderedCollection new. + scanner := self bus: 0 device: 0 function: 0. + 0 to: 255 do: [:bus | + 0 to: 31 do: [:device | + scanner + bus: bus; + device: device; + function: 0. + scanner isValid ifTrue: [ + answer add: scanner copy. + scanner isMultiFunction ifTrue: [ + 1 to: 7 do: [:function | + scanner function: function. + scanner isValid ifTrue: [answer add: scanner copy] + ] + ] + ] + ] + ]. + ^ answer +! ! + +!PCIBusEntry class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +bus: bus device: device function: function + ^ (self onPort: 16rCF8) + bus: bus; + device: device; + function: function. +! ! + +!PCIBusEntry class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + " + PCIBusEntry initialize + " + self initializeVendorsAndDevicesList +! ! + +!PCIBusEntry class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeVendorsAndDevicesList + " self initializeVendorsAndDevicesList " + ^VendorsAndDevices := self parseVendorsAndDevicesFromPCIIDsDatabase: (ReadStream on: self vendorsAndDevicesData). +! ! + +!PCIBusEntry class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeVendorsAndDevicesMethod + " self initializeVendorsAndDevicesMethod " + " The old csv file was downloaded from http://www.pcidatabase.com/reports.php?type=csv " + " We are currently using a more complete database from http://pci-ids.ucw.cz/ " + | file data | + file := StandardFileStream readOnlyFileNamed: 'info/Buses/pci/pci.ids'. + + data := ZLibWriteStream on: String new. + data nextPutAll: file contents. + data close. + self class compile: 'vendorsAndDevicesZLibData',String cr,' ^ ', data encodedStream contents storeString. + +! ! + +!PCIBusEntry class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +numberFromString: str + | strm head base | + strm := ReadStream on: str asUppercase. + strm peekFor: $". + head := strm next: 2. + head size > 1 + ifTrue: [ + base := 10. + head = '0X' + ifTrue: [base := 16] + ifFalse: [ + head = '&#' ifFalse: [strm skip: -2]]] + ifFalse: [strm skip: -1]. + ^ [Number readFrom: strm base: base] ifError: [0] +! ! + +!PCIBusEntry class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +parseVendorsAndDevicesFromPCIDatabase: strm + " The csv file was downloaded from http://www.pcidatabase.com/reports.php?type=csv " + | line fields vendors vendor device | + vendors := Dictionary new. + [line := strm upTo: Character lf. + line notNil and: [line size > 0]] whileTrue: [ + fields := (line findBetweenSubStrs: #('","')) asArray. + fields size >= 2 + ifTrue: [ + vendor := self numberFromString: (fields at: 1). + device := self numberFromString: (fields at: 2). + vendors at: (vendor << 32 + device) put: fields. + vendors at: vendor put: (fields at: 3)] + ifFalse: [Transcript show: line; cr]. + ]. + + ^ vendors +! ! + +!PCIBusEntry class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +parseVendorsAndDevicesFromPCIIDsDatabase: strm + " The csv file was downloaded from http://pci-ids.ucw.cz/ " + "# Syntax: + # vendor vendor_name + # device device_name <-- single tab + # subvendor subdevice subsystem_name <-- two tabs + " + + | vendors tok vendorId subId deviceId description | + vendors := Dictionary new. + [strm atEnd] whileFalse: [ + tok := strm peek. + tok == Character tab + ifTrue: [ " starts with tab " + strm next. + tok := strm peek. + tok == Character tab + ifTrue: [ "# subvendor subdevice subsystem_name" + strm next. + subId := strm upTo: Character space. + strm skipSeparators. + subId := subId, (strm upTo: Character space). + strm upTo: Character lf. + ] ifFalse: [ "# device device_name" + deviceId := (strm upTo: Character space) asUppercase. + deviceId := Number readFrom: deviceId base: 16. + strm skipSeparators. + description := strm upTo: Character lf. + vendors at: vendorId << 32 + deviceId put: description. + ] + ] ifFalse: [ " doesn't start with tab " + tok == $C + ifTrue: [ " device classes, not supported yet. Assume end " + strm setToEnd. + ] ifFalse: [ + (tok == $# or: [tok == Character lf]) + ifTrue: [strm upTo: Character lf] + ifFalse: [ "# vendorId vendor name " + vendorId := (strm upTo: Character space) asUppercase. + vendorId := Number readFrom: vendorId base: 16. + strm skipSeparators. + description := strm upTo: Character lf. + vendors at: vendorId put: description. + ] + ] + ] + ]. + + ^ vendors +! ! + +!PCIBusEntry class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +pciidsLocation + ^'http://pci-ids.ucw.cz/pci.ids' +! ! + +!PCIBusEntry class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +stringForVendor: vendorId device: deviceId + | vendor device | + vendor := VendorsAndDevices + at: vendorId + ifAbsent: ['unknown ', vendorId hex]. + device := VendorsAndDevices + at: vendorId << 32 + deviceId + ifAbsent: ['unknown ', deviceId hex]. + ^ 'Vendor: ', vendor, 'id()', vendorId hex printString, 'Device: ', device, 'id()', deviceId hex printString + +! ! + +!PCIBusEntry class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +vendorsAndDevicesData + " + PCIBusEntry vendorsAndDevicesData + " + ^self pciidsLocation asUrl retrieveContents contents +! ! + + +PCIBusEntry initialize! + diff --git a/modules/NOS/Devices/PC/PCIDevice.Class.st b/modules/NOS/Devices/PC/PCIDevice.Class.st new file mode 100644 index 00000000..8c8434db --- /dev/null +++ b/modules/NOS/Devices/PC/PCIDevice.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PCIDevice category: 'SqueakNOS-Devices-Base'! +HardwareDevice subclass: #PCIDevice + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Base'! +!PCIDevice commentStamp: '' prior: 0! + +I represent the base class for PCI device drivers. I almost don't provide +any extra API, except for instantiation, so my use is just organizational. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PCIDevice class' category: 'SqueakNOS-Devices-Base'! +PCIDevice class + instanceVariableNames: ''! + +!PCIDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + | pciEntry | + pciEntry := PCIBusEntry allValid + detect: [:e | e vendorId = self vendorId and: [e deviceId = self deviceId]] + ifNone: [^ nil]. + ^ self onPCIEntry: pciEntry computer: aComputer. + +! ! + +!PCIDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +onPCIEntry: aPCIBusEntry + ^self onPort: aPCIBusEntry allIORanges first key + +! ! + +!PCIDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +onPCIEntry: aPCIBusEntry computer: aComputer + | answer | + answer := self onPCIEntry: aPCIBusEntry. + + aPCIBusEntry + enableBusMastering; + enableIO. + + " copyed from GRUB, not sure if needed or not:" + aPCIBusEntry latencyTimer < 32 ifTrue: [aPCIBusEntry latencyTimer: 32]. + + aComputer interruptController + addHandler: answer + forIRQ: aPCIBusEntry interruptLine. + + ^ answer +! ! + + diff --git a/modules/NOS/Devices/PC/PIC8259.Class.st b/modules/NOS/Devices/PC/PIC8259.Class.st new file mode 100644 index 00000000..f8accdfe --- /dev/null +++ b/modules/NOS/Devices/PC/PIC8259.Class.st @@ -0,0 +1,167 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PIC8259 category: 'SqueakNOS-Devices-Base'! +HardwareDevice subclass: #PIC8259 + instanceVariableNames: 'computer slave dispatchers savedMask' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Base'! +!PIC8259 methodsFor: 'dispatching' stamp: 'KenD 28/Jun/2026 13:32:24'! +addHandler: anObject forIRQ: aNumber + " the master mantains the array of dispatchers" + | dispatcher | + + dispatcher := self dispatcherForIRQ: aNumber. + dispatcher ifNil: [ + dispatcher := InterruptRequestDispatcher onIRQ: aNumber. + self dispatcher: dispatcher forIRQ: aNumber. + dispatcher + addHandler: anObject; + installOn: computer. + ] ifNotNil: [ + dispatcher addHandler: anObject]. + + Transcript cr; show: + 'handler for IRQ #', + aNumber printString, + ' installed: ', + anObject printString. +! ! + +!PIC8259 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +computer + ^ computer +! ! + +!PIC8259 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +computer: aComputer + computer := aComputer. + slave ifNotNil: [slave computer: aComputer] +! ! + +!PIC8259 methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableAll + 0 to: 7 do: [:i | self disableIRQ: i]. + slave ifNotNil: [slave disableAll] +! ! + +!PIC8259 methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableIRQ: aNumber + aNumber > 7 + ifTrue: [ + slave disableIRQ: aNumber - 8. + slave isAnyEnabled ifFalse: [self disableIRQ: 2]] + ifFalse: [ + savedMask := savedMask bitOr: 1 << aNumber. + self byteAt: 1 put: savedMask]. + +" Transcript cr; show: 'IRQ #', aNumber printString, ' disabled. Mask: ',savedMask hex. +" +! ! + +!PIC8259 methodsFor: 'dispatching' stamp: 'KenD 28/Jun/2026 13:32:24'! +dispatcher: anIRQDispatcher forIRQ: aNumber + ^ aNumber > 7 + ifTrue: [slave dispatcher: anIRQDispatcher forIRQ: aNumber - 8] + ifFalse: [dispatchers at: aNumber + 1 put: anIRQDispatcher] +! ! + +!PIC8259 methodsFor: 'dispatching' stamp: 'KenD 28/Jun/2026 13:32:24'! +dispatcherForIRQ: aNumber + ^ aNumber > 7 + ifTrue: [slave dispatcherForIRQ: aNumber - 8] + ifFalse: [dispatchers at: aNumber + 1]. +! ! + +!PIC8259 methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableIRQ: aNumber + aNumber > 7 + ifTrue: [ + slave enableIRQ: aNumber - 8. + self enableIRQ: 2] + ifFalse: [ + savedMask := savedMask bitClear: 1 << aNumber. + self byteAt: 1 put: savedMask]. + +" Transcript cr; show: 'IRQ #', aNumber printString, ' enabled. Mask: ',savedMask printStringHex +" +! ! + +!PIC8259 methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + dispatchers := Array new: 8. + savedMask := 0. + self disableAll. + +! ! + +!PIC8259 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isAnyEnabled + ^ savedMask ~= 16rFF +! ! + +!PIC8259 methodsFor: 'dispatching' stamp: 'KenD 28/Jun/2026 13:32:24'! +removeDispatcher: anIRQDispatcher + ^ self dispatcher: nil forIRQ: anIRQDispatcher interruptNumber +! ! + +!PIC8259 methodsFor: 'dispatching' stamp: 'KenD 28/Jun/2026 13:32:24'! +removeHandler: anObject forIRQ: aNumber + " the master mantains the array of dispatchers" + | dispatcher | + + dispatcher := self dispatcherForIRQ: aNumber. + dispatcher ifNotNil: [dispatcher removeHandler: anObject]. + + Transcript cr; show: + 'handler for IRQ #', + aNumber printString, + ' removed: ', + anObject printString. +! ! + +!PIC8259 methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +signalEndOfInterrupt: interruptNumber + interruptNumber > 7 ifTrue: [slave signalEndOfInterrupt: interruptNumber - 8]. + self byteAt: 0 put: 16r20. +" Transcript cr; show: 'end of IRQ #', interruptNumber printString. +" +! ! + +!PIC8259 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +slave + ^ slave +! ! + +!PIC8259 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +slave: aPIC8259 + slave := aPIC8259. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PIC8259 class' category: 'SqueakNOS-Devices-Base'! +PIC8259 class + instanceVariableNames: ''! + +!PIC8259 class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + ^ (aComputer has: #interruptController) + ifFalse: [aComputer + interruptController: (self master computer: aComputer)] +! ! + +!PIC8259 class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +master + ^ ((self onPort: 16r20) + slave: self slave) enableIRQ: 0 +! ! + +!PIC8259 class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +slave + ^ self onPort: 16rA0 +! ! + + +PIC8259 initialize! + diff --git a/modules/NOS/Devices/PC/PS2Keyboard.Class.st b/modules/NOS/Devices/PC/PS2Keyboard.Class.st new file mode 100644 index 00000000..29e1178b --- /dev/null +++ b/modules/NOS/Devices/PC/PS2Keyboard.Class.st @@ -0,0 +1,923 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PS2Keyboard category: 'SqueakNOS-Devices-Base'! +HardwareDevice subclass: #PS2Keyboard + instanceVariableNames: 'modifiersAndButtons mouseCoord mouseDataCount events previousScanCode configBits decoder keysMapping' + classVariableNames: '' + poolDictionaries: 'EventSensorConstants' + category: 'SqueakNOS-Devices-Base'! +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +checkPassword + self controllerCommand: 16rA6. +" ^ self readData" +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearCommandBit: bit + ^ self commandByte: (self commandByte bitClear: 1 << bit) + +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +commandByte + self controllerCommand: 16r20. + ^ self readKeyboardData. +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +commandByte: value + self controllerCommand: 16r60. + self keyboardCommand: value. +! ! + +!PS2Keyboard methodsFor: 'low level protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +controllerCommand: cmd + self waitToWrite ifFalse: [^false]. + self controllerPort: cmd. + ^true +! ! + +!PS2Keyboard methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +controllerPort: cmd + ^ self byteAt: 4 put: cmd +! ! + +!PS2Keyboard methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +dataPort + ^ self byteAt: 0 +! ! + +!PS2Keyboard methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +dataPort: value + ^ self byteAt: 0 put: value +! ! + +!PS2Keyboard methodsFor: 'low level protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableIRQsWhile: aBlock + | answer | + self controllerCommand: 16r60; dataPort: 0. + answer := aBlock value. + self controllerCommand: 16r60; dataPort: 16r47. + ^ answer + +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableInputBufferFullInterrupt + ^ self clearCommandBit: 0 +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableInterrupts + ^self disableInputBufferFullInterrupt; disableMouseInputBufferFullInterrupt + +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableKeyboard + self keyboardCommand: 16rF5. + ^ self waitKeyboardAck +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableKeyboardInterface + self controllerCommand: 16rAD. + +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableMouse + ^ self mouseCommand: 16rF5. +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableMouseInputBufferFullInterrupt + ^ self clearCommandBit: 1 +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableMouseInterface + self controllerCommand: 16rA7. + +! ! + +!PS2Keyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableMouseScrollingParsing + configBits := configBits bitClear: 1 +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableScancodeTranslation + ^ self clearCommandBit: 6 +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableWrapMode + ^ self mouseCommand: 16rEC. +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enable1in1Scaling + ^self mouseCommand: 16rE6. +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enable2in1Scaling + ^self mouseCommand: 16rE7. +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableKeyboard + self keyboardCommand: 16rF4. + ^ self waitKeyboardAck +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableKeyboardInputBufferFullInterrupt + ^ self setCommandBit: 0 +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableKeyboardInterface + self controllerCommand: 16rAE. + +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableMouse + ^ self mouseCommand: 16rF4. +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableMouseInputBufferFullInterrupt + ^ self setCommandBit: 1 +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableMouseInterface + self controllerCommand: 16rA8. + +! ! + +!PS2Keyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableMouseScrollingParsing + configBits := configBits bitOr: 1 +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableRemoteMode + ^ self mouseCommand: 16rF0. +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableScancodeTranslation + ^ self setCommandBit: 6 +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableStreamMode + ^ self mouseCommand: 16rEA. +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableWrapMode + ^ self mouseCommand: 16rEE. +! ! + +!PS2Keyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleIRQ + [self keyboardOutputBufferFull] whileTrue: [ + self mouseOutputBufferFull + ifTrue: [self handleMouseIRQ] + ifFalse: [self handleKeyboardIRQ]] + + +! ! + +!PS2Keyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleKeyboardIRQ + | scanCode key | + scanCode := self readKeyboardData. + "Transcript show: 'keyboard irq: ', scanCode hex, String cr." + + decoder nextScanCode: scanCode. + + decoder nextKeyReady ifFalse: [^self]. + + decoder isModifier + ifFalse: [ "it's an ascii caracter" + key := decoder keyUsing: keysMapping modifiers: modifiersAndButtons. + key asciiValue = 0 ifTrue: [^self]. + decoder isKeyUp + ifTrue: [ self newKeyboardUpEvent: key ] + ifFalse: [ self newKeyboardDownEvent: key]. + ] + ifTrue: [ " it's a modifier " + "modifiersAndButtons := modifiersAndButtons bitXor: decoder translateModifierScanCode." + + decoder isKeyUp + ifTrue: [ modifiersAndButtons := modifiersAndButtons bitClear: decoder translateModifierScanCode ] + ifFalse: [ modifiersAndButtons := modifiersAndButtons bitOr: decoder translateModifierScanCode ]. + ]. + + + + +! ! + +!PS2Keyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleMouseIRQ + | data | + data := self readMouseData. + "Transcript show: 'mouse irq: ', data hex, String cr." + + "self mouseScrollingEnabled + ifTrue: [Keys1 add: 'Number ', mouseDataCount asString, ' data ', data asString, ' +'. ]." + + mouseDataCount == 0 ifTrue: [ "button state" + mouseDataCount := mouseDataCount + 1. + ^ modifiersAndButtons := (((modifiersAndButtons bitClear: 16r7) + bitOr: (data bitAnd: 2)) + bitOr: (data bitAnd: 1) << 2) + bitOr: (data bitAnd: 4) >> 2]. + + data >= 16r80 ifTrue: [data := data - 16r100]. + + mouseDataCount == 1 ifTrue: [ "x delta " + mouseDataCount := mouseDataCount + 1. + "Transcript show: 'x delta: ', data printString." + ^ mouseCoord := data @ 0 + mouseCoord]. + + + mouseDataCount = 2 ifTrue: [ " y delta " + "Transcript show: 'y delta: ', data printString." + mouseCoord := mouseCoord - (0 @ data) adhereTo: Display boundingBox. + ]. + + self mouseScrollingEnabled + ifTrue: [ + mouseDataCount = 2 ifTrue: [^mouseDataCount := mouseDataCount + 1.] ] + ifFalse:[ + mouseDataCount := 0. + ^self newMouseEvent]. + + " mouseDataCount == 3: z delta " + mouseDataCount := 0. + data < 0 ifTrue:["Scrolling up" + ^self newKeyboardControlCharEvent: Character arrowUp]. + data > 0 ifTrue:["Scrolling down" + ^self newKeyboardControlCharEvent: Character arrowDown]. + self newMouseEvent. +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasPassword + self controllerCommand: 16rA4. + ^ self readKeyboardData == 16rFA +! ! + +!PS2Keyboard methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + + mouseDataCount := modifiersAndButtons := 0. + mouseCoord := DisplayScreen actualScreenSize // 2. + configBits := 0. + + keysMapping := self class generatedEnglishKeysMapping. + decoder := ScancodeDecoder new. + + self initializeHardware. + self initializeEventsQueue. +! ! + +!PS2Keyboard methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeEventsQueue + | p block | + events := SharedQueue new. + Computer isPharo + ifTrue: [ block := [ Sensor handleEvent: events next ] ] + ifFalse: [ block := [ Sensor processEvent: events next] ]. + p := [ block repeat] forkAt: Processor highIOPriority. + + p name: 'PS2Keboard shared queue poll' +! ! + +!PS2Keyboard methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeHardware + self + initializeKeyboardHardware; + initializeMouseHardware. + +" self enableKeyboardInputBufferFullInterrupt; not needed, commandByte: 16r47 enables all + enableKeyboardInterface. +" + self commandByte: 16r47. " enable mouse and keyboard, and set scan code 1 " + +! ! + +!PS2Keyboard methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeKeyboardHardware + + self report: 'Performing keyboard initialization'; + commandByte: 0. + self report: 'reseting keyboard'. + self + resetKeyboard; + commandByte: 0; + report: 'keyboard reset.'. + + self testController + ifFalse: + [self report: 'controller self test: failed.'. + ^ false]. + + self report: 'controller self test: Ok'. + self testKeyboardInterface + ifFalse: + [self report: 'keyboard self test: failed.'. + ^ false]. + self report: 'keyboard self test: Ok'. + + self testKeyboardEcho + ifFalse: + [self report: 'keyboard echo: failed.'. + ^ false]. + self report: 'keyboard echo: Ok'"; + keyboardLeds: 0; + keyboardScanCodeSet: 1". " this two commented out because they take too long to complete :( " + +! ! + +!PS2Keyboard methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeMouseHardware + + self report: 'Performing mouse initialization'. + + self testMouseInterface ifTrue: [ + self report: 'Mouse present'. + self mouseSampleRate: 16rC8. + self mouseSampleRate: 16r64. + self mouseSampleRate: 16r50. + self mouseId = 16r03 + ifTrue: [ + self report: 'Enabling mouse scrolling.'. + self enableMouseScrollingParsing] + ifFalse: [self disableMouseScrollingParsing]. +" self disableMouseScrollingParsing." + self "disableMouse; + resetMouse;" + enableMouse"; + enableMouseInputBufferFullInterrupt; not needed, commandByte: 16r47 enables all + enableMouseInterface"]. + +! ! + +!PS2Keyboard methodsFor: 'hardware status' stamp: 'KenD 28/Jun/2026 13:32:24'! +inputBufferFull + ^ self statusPort anyMask: 2 +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +inputPort + self controllerCommand: 16rCO. + ^ self readKeyboardData. +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardBuffer: value + self controllerCommand: 16rD2. + self keyboardCommand: value. + +! ! + +!PS2Keyboard methodsFor: 'low level protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardCommand: cmd + self waitToWrite ifFalse: [^false]. + self dataPort: cmd. + ^true +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardId + self keyboardCommand: 16rF2. + self waitKeyboardAck. + ^(self readKeyboardData bitShift: 8) bitOr: self keyboardData. +! ! + +!PS2Keyboard methodsFor: 'hardware status' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardInhibited + ^ (self statusPort anyMask: 16) not +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardLeds: value + self keyboardCommand: 16rED. + self waitKeyboardAck. + self keyboardCommand: value. + ^self waitKeyboardAck. + +! ! + +!PS2Keyboard methodsFor: 'hardware status' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardOutputBufferFull + ^ self statusPort anyMask: 1 +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardScanCodeSet: value + value == 1 + ifTrue: [self setCommandBit: 6] + ifFalse: [self clearCommandBit: 6]. +" self keyboardCommand: 16rF0. + self waitKeyboardAck. + self keyboardCommand: value. + ^self waitKeyboardAck. +" +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyboardTypematicRateDelay: value + self keyboardCommand: 16rF3. + self waitKeyboardAck. + self keyboardCommand: value. + ^self waitKeyboardAck +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +mouseBuffer: value + self controllerCommand: 16rD3. + self keyboardCommand: value. + +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +mouseCommand: value + self controllerCommand: 16rD4. + self keyboardCommand: value. + ^ self waitMouseAck. +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +mouseCommandNoAck: value + self controllerCommand: 16rD4. + self keyboardCommand: value. +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +mouseId + self mouseCommand: 16rF2. + ^self readMouseData +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +mouseInputBufferInterruptEnabled + ^ self testCommandBit: 2 +! ! + +!PS2Keyboard methodsFor: 'hardware status' stamp: 'KenD 28/Jun/2026 13:32:24'! +mouseOutputBufferFull + ^ self statusPort anyMask: 32 +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +mouseResolution: value + ^ (self mouseCommand: 16rE8) and: [self mouseCommand: value] +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +mouseSampleRate: value + ^ (self mouseCommand: 16rF3) and: [self mouseCommand: value] +! ! + +!PS2Keyboard methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +mouseScrollingEnabled + ^ configBits anyMask: 1 +! ! + +!PS2Keyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +newKeyboardControlCharEvent: char + modifiersAndButtons := (modifiersAndButtons bitOr: 16r10). + self newKeyboardEvent: char type: EventKeyChar. + modifiersAndButtons := modifiersAndButtons bitClear: 16r10. + +! ! + +!PS2Keyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +newKeyboardDownEvent: aCharacter + self newKeyboardEvent: aCharacter type: EventKeyDown. + self newKeyboardEvent: aCharacter type: EventKeyChar. + +! ! + +!PS2Keyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +newKeyboardEvent: aCharacter type: byteType + " taken from EventSensor >> #nextEventSynthesized " + | event | + "Transcript show: aCharacter asciiValue." + (event := Array new: 8) + at: 1 put: EventTypeKeyboard; "evt type" + at: 2 put: Time millisecondClockValue; "time stamp" + at: 3 put: aCharacter asciiValue; "char code" + at: 4 put: byteType; "key press/release" + at: 5 put: modifiersAndButtons >> 3; "modifier keys" + at: 6 put: aCharacter asciiValue; "utf32Code, TODO: translate to utf32" + at: 7 put: 0; "reserved" + at: 8 put: 1. "window index" + + events nextPut: event. +! ! + +!PS2Keyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +newKeyboardUpEvent: aCharacter + self newKeyboardEvent: aCharacter type: EventKeyUp +! ! + +!PS2Keyboard methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +newMouseEvent + | modifiers buttons mapped event | + modifiers := modifiersAndButtons bitShift: -3. + buttons := modifiersAndButtons bitAnd: 7. + mapped := Sensor mapButtons: buttons modifiers: modifiers. + (event := Array new: 8) + at: 1 put: EventTypeMouse; + at: 2 put: Time millisecondClockValue; + at: 3 put: mouseCoord x; + at: 4 put: mouseCoord y; + at: 5 put: mapped; + at: 6 put: modifiers; + at: 7 put: 0; + at: 8 put: 1. + events nextPut: event. + "self report: event. + WorldMorph doOneCycle" + +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +outputPort + self controllerCommand: 16rDO. + ^ self readKeyboardData. +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +outputPort: value + self controllerCommand: 16rD1. + self keyboardCommand: value. + +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +outputPortLow: value + self controllerCommand: 16r90 + (value bitAnd: 15). + +! ! + +!PS2Keyboard methodsFor: 'hardware status' stamp: 'KenD 28/Jun/2026 13:32:24'! +paryityError + ^ self statusPort anyMask: 128 +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +pollMouseDataPacket + self mouseCommand: 16rEB. + ^self readMouseDataPacket +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +pulseOutputPortLow: value + self controllerCommand: 16rF0 + (value bitAnd: 15). +! ! + +!PS2Keyboard methodsFor: 'low level protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +readKeyboardData + self waitToReadKeyboard ifFalse: [^nil]. + ^self dataPort +! ! + +!PS2Keyboard methodsFor: 'low level protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +readMouseData + self waitToReadMouse ifFalse: [^nil]. + ^self dataPort. +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +readMouseDataPacket + ^ Array with: self readMouseData with: self readMouseData with: self readMouseData +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +readMouseStatus + self mouseCommand: 16rE9. + ^self readMouseData +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +resendKeyboardCommand + self keyboardCommand: 16rFE. + ^ self readKeyboardData +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +resendMouseCommand + ^ self mouseCommand: 16rFE. +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetKeyboard + | answer | + self keyboardCommand: 16rFF. + self waitKeyboardAck ifFalse: [^false]. + (answer := self readKeyboardData) ifNil: [^ false]. + answer == 16rAA ifTrue: [^true]. + answer ~~ 16rFC ifTrue: [self report: 'Unexpected answer to reset command: ', answer hex]. + ^ false +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetMouse + | answer | + (self mouseCommand: 16rFF) ifFalse: [^false]. + answer := self readMouseData. + answer == 16rAA ifTrue: [^self readMouseData == 0 " mouse sends device ID after reset "]. + answer ~~ 16rFC ifTrue: [self report: 'Unexpected answer to reset command: ', answer hex]. + ^ false +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +scancodeTranslationEnabled + ^ self testCommandBit: 16r40 +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +setCommandBit: bit + ^ self commandByte: (self commandByte bitOr: 1 << bit) +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +setKeyboardDefaults + self keyboardCommand: 16rF6. + ^ self waitKeyboardAck +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +setMouseDefaults + ^ self mouseCommand: 16rF6. +! ! + +!PS2Keyboard methodsFor: 'keyboard access' stamp: 'KenD 28/Jun/2026 13:32:24'! +shiftPressed + ^ modifiersAndButtons anyMask: 8 +! ! + +!PS2Keyboard methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusPort + ^ self byteAt: 4 +! ! + +!PS2Keyboard methodsFor: 'hardware status' stamp: 'KenD 28/Jun/2026 13:32:24'! +systemInitialized + ^ self statusPort anyMask: 4 +! ! + +!PS2Keyboard methodsFor: 'command byte' stamp: 'KenD 28/Jun/2026 13:32:24'! +testCommandBit: mask + ^ self commandByte anyMask: mask +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +testController + self controllerCommand: 16rAA. + ^ self readKeyboardData == 16r55 + +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +testKeyboardEcho + self keyboardCommand: 16rEE. + ^ self readKeyboardData == 16rEE +! ! + +!PS2Keyboard methodsFor: 'keyboard commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +testKeyboardInterface + self controllerCommand: 16rAB. + ^ self readKeyboardData isZero + +! ! + +!PS2Keyboard methodsFor: 'mouse commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +testMouseInterface + self controllerCommand: 16rA9. + ^ self readKeyboardData isZero + +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +testPort + self controllerCommand: 16rE0. + ^ self readKeyboardData +! ! + +!PS2Keyboard methodsFor: 'hardware status' stamp: 'KenD 28/Jun/2026 13:32:24'! +timeoutError + ^ self statusPort anyMask: 64 +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +version + self controllerCommand: 16rAD. +" ^ self readData." +! ! + +!PS2Keyboard methodsFor: 'controller commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +versionNumber + self controllerCommand: 16rA1. +" ^ self readData." +! ! + +!PS2Keyboard methodsFor: 'low level protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitKeyboardAck + ^ self readKeyboardData == 16rFA +! ! + +!PS2Keyboard methodsFor: 'low level protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitMouseAck + ^ self readMouseData == 16rFA +! ! + +!PS2Keyboard methodsFor: 'low level protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitToReadKeyboard + | delay | + self keyboardOutputBufferFull ifTrue: [^true]. + delay := Delay forMilliseconds: 1. + 1000 timesRepeat: [ + "FIXME: cannot wait because the process switch seems to kill the image" + "delay wait." + self keyboardOutputBufferFull ifTrue: [^true] + ]. + self report: 'timedout out witing for keyboard input.'. + ^false + +! ! + +!PS2Keyboard methodsFor: 'low level protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitToReadMouse + | delay | + self mouseOutputBufferFull ifTrue: [^true]. + delay := Delay forMilliseconds: 1. + 250 timesRepeat: [ + delay wait. + self mouseOutputBufferFull ifTrue: [^true] + ]. + self report: 'timedout out witing for mouse input.'. + ^false + +! ! + +!PS2Keyboard methodsFor: 'low level protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitToWrite + | delay | + self inputBufferFull ifFalse: [^true]. + delay := Delay forMilliseconds: 1. + 250 timesRepeat: [ + delay wait. + self inputBufferFull ifFalse: [^true] + ]. + self report: 'timedout out witing to write.'. + ^false + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PS2Keyboard class' category: 'SqueakNOS-Devices-Base'! +PS2Keyboard class + instanceVariableNames: ''! + +!PS2Keyboard class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +cCharsToArray: aString + | strm table | + strm := ReadStream on: aString. + strm reset. + table := OrderedCollection new: 128. + [strm atEnd] + whileFalse: [strm peek = $\ + ifTrue: + [strm next. + strm peek isDigit + ifTrue: [table add: (Character value: ('8r' , (strm next: 3)) asNumber)] + ifFalse: [table add: (self unescapeCharacter: strm next)]] + ifFalse: [table add: strm next]]. + ^ table asArray +! ! + +!PS2Keyboard class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +fixPasteUpMorphIfPharo + Computer isPharo ifFalse: [^self]. + PasteUpMorph compile: + 'morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock + "Include hands if the receiver is the World" + self handsDo:[:m| + m == someMorph ifTrue:[ "Try getting out quickly" + owner ifNil:[^self]. + ^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock + ] + ]. + + ^super morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock' + classified: 'submorphs-accessing'. + +! ! + +!PS2Keyboard class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +generatedEnglishKeysMapping + + | mapping temp | + + mapping := Dictionary new. + + mapping at: #(none) put: (self cCharsToArray: '\0331234567890-=\010\t' , + 'qwertyuiop[]\r\000as' , + 'dfghjkl;''`\000\\zxcv' , + 'bnm,./\000*\000 \000\201\202\203\204\205' , + '\206\207\210\211\212\000\000789-456+1' , + '230\177\000\000\213\214\000\000\000\000\000\000\000\000\000\000' , + '\r\000/'). + + mapping at: #(shift) put: (self cCharsToArray: + '\033!!@#$%^&*()_+\010\t' , + 'QWERTYUIOP{}\r\000AS' , + 'DFGHJKL:"~\000|ZXCV' , + 'BNM<>?\000*\000 \000\201\202\203\204\205' , + '\206\207\210\211\212\000\000789-456+1' , + '230\177\000\000\213\214\000\000\000\000\000\000\000\000\000\000' , + '\r\000/'). + + mapping at: #(alt) put: (Array new: 128 withAll: (Character value: 0)). + mapping at: #(shift alt) put: (Array new: 128 withAll: (Character value: 0)). + + temp := Array new: 128 withAll: (Character value: 0). + temp at: 16r48 put: Character arrowUp. + temp at: 16r50 put: Character arrowDown. + temp at: 16r4D put: Character arrowRight. + temp at: 16r4B put: Character arrowLeft. + temp at: 16r47 put: Character home. + temp at: 16r4F put: Character end. + temp at: 16r49 put: Character pageUp. + temp at: 16r51 put: Character pageDown. + temp at: 16r52 put: Character insert. + temp at: 16r53 put: Character delete. + + mapping at: #(extended) put: temp. + + ^mapping. +! ! + +!PS2Keyboard class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +generatedSpanishKeysMapping + + | mapping | + + mapping := self generatedEnglishKeysMapping. + + "TODO: fill this" + "mapping at: #(none) put: Dictionary new. + mapping at: #(shift) put: Dictionary new. + mapping at: #(alt) put: Dictionary new. + mapping at: #(alt shift) put: Dictionary new. + mapping at: #(extended) put: Dictionary new. + " + + ^mapping. +! ! + +!PS2Keyboard class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + +! ! + +!PS2Keyboard class methodsFor: 'system startup' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + | keyboard p | + keyboard := self onPort: 16r60. + aComputer interruptController addHandler: keyboard forIRQ: 1. + aComputer interruptController addHandler: keyboard forIRQ: 12. + self fixPasteUpMorphIfPharo. + Cursor normal show. + + ^ true + +! ! + +!PS2Keyboard class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +unescapeCharacter: char + char = $t ifTrue: [^ Character tab]. + char = $r ifTrue: [^ Character cr]. + char = $n ifTrue: [^ Character lf]. + ^ char +! ! + + +PS2Keyboard initialize! + diff --git a/modules/NOS/Devices/PC/ScancodeDecoder.Class.st b/modules/NOS/Devices/PC/ScancodeDecoder.Class.st new file mode 100644 index 00000000..2fc25785 --- /dev/null +++ b/modules/NOS/Devices/PC/ScancodeDecoder.Class.st @@ -0,0 +1,95 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #ScancodeDecoder category: 'SqueakNOS-Devices-Base'! +Object subclass: #ScancodeDecoder + instanceVariableNames: 'previousScanCode actualScanCode' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Base'! +!ScancodeDecoder methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +altGrPressedIn: aModifiersRegister + ^(aModifiersRegister bitAnd: 16r40) > 0 and: [(aModifiersRegister bitAnd: 16r10 ) > 0 ]. +! ! + +!ScancodeDecoder methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +correspondingMapWith: aModifiersRegister + + "rule 1 - extended keys aren't affected by modifiers like control and alt gr. + rule 2 - caps lock isn't handled here, because " + + | modifiers | + modifiers := OrderedCollection new. + + previousScanCode == 16rE0 ifTrue: [ modifiers add: #extended. ^modifiers asArray. ]. + + (self shiftPressedIn: aModifiersRegister) ifTrue: [ modifiers add: #shift ]. + (self altGrPressedIn: aModifiersRegister) ifTrue: [ modifiers add: #alt ]. + + modifiers ifEmpty: [modifiers add: #none]. + + ^modifiers asArray. +! ! + +!ScancodeDecoder methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +isKeyUp + ^actualScanCode anyMask: 16r80. +! ! + +!ScancodeDecoder methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +isModifier + ^self translateModifierScanCode > 0. +! ! + +!ScancodeDecoder methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +keyUsing: aKeysMapping modifiers: modifiers + | normalizedCode | + normalizedCode := actualScanCode bitClear: 16r80. + + ^(aKeysMapping at: (self correspondingMapWith: modifiers)) at: (normalizedCode ). + +! ! + +!ScancodeDecoder methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextKeyReady + ^(actualScanCode == 16rE0 | (actualScanCode == 16rE1)) not. "If extended scancode we have to wait next to complete" + + +! ! + +!ScancodeDecoder methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextScanCode: aScanCode + previousScanCode := actualScanCode. + actualScanCode := aScanCode. + +! ! + +!ScancodeDecoder methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +shiftPressedIn: aModifiersRegister + ^(aModifiersRegister bitAnd: 8 ) > 0. + +! ! + +!ScancodeDecoder methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +translateModifierScanCode + + | normalizedCode | + + previousScanCode = 16rE0 ifTrue: [^ 0]. "Is an extended scancode, can't be a modifier" + + normalizedCode := actualScanCode bitClear: 16r80. + + normalizedCode == 16r2A ifTrue: [^ 8]. " left shift " + normalizedCode == 16r36 ifTrue: [^ 8]. " right shift " + normalizedCode == 16r38 ifTrue: [^ 16r40]. " left ALT (command key) " + normalizedCode == 16r1D ifTrue: [^ 16r10]. " left CTRL " + + ^ 0. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ScancodeDecoder class' category: 'SqueakNOS-Devices-Base'! +ScancodeDecoder class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Devices/PC/UART16550.Class.st b/modules/NOS/Devices/PC/UART16550.Class.st new file mode 100644 index 00000000..cf531ff8 --- /dev/null +++ b/modules/NOS/Devices/PC/UART16550.Class.st @@ -0,0 +1,97 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #UART16550 category: 'SqueakNOS-Devices-Base'! +UART8250 subclass: #UART16550 + instanceVariableNames: 'fifoStatus' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Base'! +!UART16550 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +close + super close. + self fifoControlRegister: 0 + +! ! + +!UART16550 methodsFor: '*SqueakNOS-BenchSupport' stamp: 'KenD 28/Jun/2026 13:32:24'! +closed + ^ false. +! ! + +!UART16550 methodsFor: 'FIFO control' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableFIFO + fifoStatus := fifoStatus bitClear: 1. + self fifoControlRegister: fifoStatus. +! ! + +!UART16550 methodsFor: 'FIFO control' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableFIFO + fifoStatus := fifoStatus bitOr: 1. + self fifoControlRegister: fifoStatus. +! ! + +!UART16550 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +fifoControlRegister + ^ self byteAt: 2 +! ! + +!UART16550 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +fifoControlRegister: aByte + ^ self byteAt: 2 put: aByte +! ! + +!UART16550 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +open + " tiene comentarios!! " + fifoStatus := 0. + super open. + self enableFIFO; + triggerLevel: 4; + resetInputQueue; + resetOutputQueue. + + + + + +! ! + +!UART16550 methodsFor: 'FIFO control' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetInputQueue + self fifoControlRegister: (fifoStatus bitOr: 2). +! ! + +!UART16550 methodsFor: 'FIFO control' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetOutputQueue + self fifoControlRegister: (fifoStatus bitOr: 4). +! ! + +!UART16550 methodsFor: 'FIFO control' stamp: 'KenD 28/Jun/2026 13:32:24'! +triggerLevel: integer + | idx | + idx := #(1 4 8 14) indexOf: integer. + idx = 0 ifTrue: [idx := 3]. "default value" + fifoStatus := fifoStatus bitOr: ((idx - 1) bitShift: 6). + self fifoControlRegister: fifoStatus +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'UART16550 class' category: 'SqueakNOS-Devices-Base'! +UART16550 class + instanceVariableNames: ''! + +!UART16550 class methodsFor: 'system startup' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + | first | + first := nil. + self detectedUARTS with: #(4 3 4 3) do: [:uart :irq | + uart notNil ifTrue: [ + first isNil ifTrue: [first := uart]. + aComputer interruptController + addHandler: uart + forIRQ: irq]]. + ^ aComputer defaultSerialPort: first. +! ! + + diff --git a/modules/NOS/Devices/PC/UART8250.Class.st b/modules/NOS/Devices/PC/UART8250.Class.st new file mode 100644 index 00000000..0e355a91 --- /dev/null +++ b/modules/NOS/Devices/PC/UART8250.Class.st @@ -0,0 +1,377 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #UART8250 category: 'SqueakNOS-Devices-Base'! +HardwareDevice subclass: #UART8250 + instanceVariableNames: 'receivedChars baudRate stopBits parity dataBits interruptId lineStatus modemStatus' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Base'! +!UART8250 commentStamp: '' prior: 0! + +This is the Serial port driver. It's useful for debugging. + +Usage example: + +This code will loop until it receives 100 bytes and will write them in transcript. Caution, will block everything until it finishes reading. +| s | +s := Computer current defaultSerialPort. +s open. +100 timesRepeat: [Transcript show: (s nextPut: s next)]. +! + +!UART8250 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +anyInterrupt + ^(interruptId bitAnd: 2r1110) ~= 0 + + +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +baudRateDivisorFor: baud + ^ 115200 // baud + +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +checkError + (lineStatus bitAnd: 16r1E) = 0 + ifFalse: [Transcript cr; show: 'Error LSR/UART ', lineStatus printStringHex] +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +close + Preferences disableLogging. + self interruptEnableRegister: 0. + self modemControlRegister: 3. + + +! ! + +!UART8250 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +dataAvailabelInRDR + ^ (lineStatus bitAnd: 1) = 1 +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +dataAvailable + ^ receivedChars isEmpty not +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableLoopbackTesting + self modemControlRegister: 16r0 +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableLoopbackTesting + self modemControlRegister: 16r10 +! ! + +!UART8250 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +exists + self enableLoopbackTesting. + self readModemStatus. + (modemStatus anyMask: 16rF0) ifTrue: [^ false]. + self modemControlRegister: 16r1F. + self readModemStatus. + (modemStatus bitAnd: 16rF0) = 16rF0 ifFalse: [^ false]. + self disableLoopbackTesting. + ^true + +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +flush + ^ self +! ! + +!UART8250 methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleIRQ + self turnOffRTS. + + [self readInterruptId. + self receivedDataPending + ifTrue: + [ + [receivedChars nextPut: (self byteAt: 0). + self readLineStatus. + self checkError. + self dataAvailabelInRDR] whileTrue]. + self interruptPending] whileTrue. + self turnOnRTS +! ! + +!UART8250 methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + baudRate := 57600. "tried 115200 but doesn't work on my vmware at least" + stopBits := 1. + parity := 0. + dataBits := 8 +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeLineControlRegisterStopBitsType: stopBitsInteger parityType: parityInteger dataBits: numDataBits + | lcr | + numDataBits = 7 + ifTrue: [lcr := 2] + ifFalse: [lcr := 3]. + stopBits = 2 ifTrue: [lcr := lcr bitOr: 4]. + parity = 0 + ifFalse: + [lcr := lcr bitOr: 8. + parity = 2 ifTrue: [lcr := lcr bitOr: 16]]. + self lineControlRegister: lcr +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptEnableRegister + ^ self byteAt: 1 +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptEnableRegister: aByte + ^ self byteAt: 1 put: aByte +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptIDRegister + ^ self byteAt: 2 +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptIDRegister: aByte + ^ self byteAt: 2 put: aByte +! ! + +!UART8250 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptPending + ^(interruptId bitAnd: 1) = 0 + + +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +isOpen + ^ true +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +lineControlRegister + ^ self byteAt: 3 +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +lineControlRegister: aByte + ^ self byteAt: 3 put: aByte +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +lineStatusRegister + ^ self byteAt: 5 +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +lineStatusRegister: aByte + ^ self byteAt: 5 put: aByte +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +modemControlRegister + ^ self byteAt: 4 +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +modemControlRegister: aByte + ^ self byteAt: 4 put: aByte +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +modemStatusRegister + ^ self byteAt: 6 +! ! + +!UART8250 methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +modemStatusRegister: aByte + ^ self byteAt: 6 put: aByte +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +next + ^ self nextByte +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +next: anInteger + | answer | + answer := ByteArray new: anInteger. + 1 to: anInteger do: [:index | answer at: index put: self next]. + ^answer +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextAvailable + | size answer | + size := receivedChars size. + answer := String new: size. + 1 to: size do: [:index | answer at: index put: self next]. + ^answer +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextByte + ^ receivedChars next +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextPut: aCharacter + self xmitByte: aCharacter asInteger. + ^ aCharacter +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextPutAll: aString + aString do: [:char | self nextPut: char]. +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +open + receivedChars := SharedQueue new. + self setBaudRate: baudRate. + self + initializeLineControlRegisterStopBitsType: stopBits + parityType: parity + dataBits: dataBits. + self byteAt: 0. + self readLineStatus. + self readModemStatus. + self modemControlRegister: 16r0B. + self interruptEnableRegister: 16r09. + self interruptIDRegister +! ! + +!UART8250 methodsFor: 'squeakNOS primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primClosePort: portNumber + self close +! ! + +!UART8250 methodsFor: 'squeakNOS primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primOpenPort: portNumber baudRate: baud stopBitsType: stop parityType: parityType dataBits: numDataBits inFlowControlType: inFlowCtrl outFlowControlType: outFlowCtrl xOnByte: xOn xOffByte: xOff + self openPort: portNumber +! ! + +!UART8250 methodsFor: 'squeakNOS primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primReadPort: portNumber into: byteArray startingAt: startIndex count: count + | index | + index := startIndex. + count timesRepeat: [ + byteArray at: index put: self nextByte. + index := index + 1]. +! ! + +!UART8250 methodsFor: 'squeakNOS primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primWritePort: portNumber from: byteArray startingAt: startIndex count: count + | index | + index := startIndex. + count timesRepeat: [self nextPut: (byteArray at: index)] +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +readInterruptId + interruptId := self interruptIDRegister + + +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +readLineStatus + lineStatus := self lineStatusRegister + + +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +readModemStatus + modemStatus := self modemStatusRegister + + +! ! + +!UART8250 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +receivedDataPending + ^(interruptId bitAnd: 2r110) = 2r100 + + +! ! + +!UART8250 methodsFor: 'device protocol' stamp: 'KenD 28/Jun/2026 13:32:24'! +reopen + self close. + self open +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +setBaudRate: baud + | brd | + baudRate := baud. + brd := self baudRateDivisorFor: baud. + self lineControlRegister: 16r80. + self interruptEnableRegister: (brd bitShift: -8). + self byteAt: 0 put: (brd bitAnd: 255). +! ! + +!UART8250 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +testTHR + ^(lineStatus bitAnd: 2r00100000) ~= 0 +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +turnOffRTS + | mcr | + mcr := self modemControlRegister. + self modemControlRegister: (mcr bitAnd: 2r11111101) + +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +turnOnRTS + self modemControlRegister: + (self modemControlRegister bitOr: 2r10). +! ! + +!UART8250 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +xmitByte: value + | process delay timeout | + timeout := false. + delay := Delay forSeconds: 5. + process := + [delay wait. + timeout := true] + forkAt: Processor lowIOPriority. + [self readLineStatus. + timeout | self testTHR] whileFalse. + timeout ifTrue: [Transcript cr; show: 'TimeOut'. ^self]. + "delay unschedule." + process terminate. + self byteAt: 0 put: value +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'UART8250 class' category: 'SqueakNOS-Devices-Base'! +UART8250 class + instanceVariableNames: ''! + +!UART8250 class methodsFor: 'system startup' stamp: 'KenD 28/Jun/2026 13:32:24'! +detectedUARTS + | uart | + ^#(16r3F8 16r2F8 16r3E8 16r2E8) + collect: [:portNumber | + uart := self onPort: portNumber. + uart exists ifTrue: [uart] ifFalse: [nil]]. + +! ! + + +UART8250 initialize! + diff --git a/modules/NOS/Devices/Processor/MicroProcessor.Class.st b/modules/NOS/Devices/Processor/MicroProcessor.Class.st new file mode 100644 index 00000000..1ad95018 --- /dev/null +++ b/modules/NOS/Devices/Processor/MicroProcessor.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #MicroProcessor category: 'SqueakNOS-Devices-Processor'! +Object subclass: #MicroProcessor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Processor'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MicroProcessor class' category: 'SqueakNOS-Devices-Processor'! +MicroProcessor class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Devices/Processor/X86Processor.Class.st b/modules/NOS/Devices/Processor/X86Processor.Class.st new file mode 100644 index 00000000..604acf35 --- /dev/null +++ b/modules/NOS/Devices/Processor/X86Processor.Class.st @@ -0,0 +1,64 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #X86Processor category: 'SqueakNOS-Devices-Processor'! +MicroProcessor subclass: #X86Processor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Processor'! +!X86Processor methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +cr0 + "primitiveExternalCall" + ^self primitiveFailed +! ! + +!X86Processor methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +cr0: statusWord + "primitiveExternalCall" + ^self primitiveFailed +! ! + +!X86Processor methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +cr3 + "primitiveExternalCall" + ^self primitiveFailed +! ! + +!X86Processor methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +cr3: memoryAddress + "primitiveExternalCall" + ^self primitiveFailed +! ! + +!X86Processor methodsFor: 'paging' stamp: 'KenD 28/Jun/2026 13:32:24'! +enablePaging + | pagingEnabled | + pagingEnabled := self cr0 bitAt: 32 put: 1. "Enable paging" + pagingEnabled := pagingEnabled bitAt: 17 put: 1. "Enable write protect" + self cr0: pagingEnabled +! ! + +!X86Processor methodsFor: 'paging' stamp: 'KenD 28/Jun/2026 13:32:24'! +enablePagingWithDirectory: memoryAddress + self pageDirectory: memoryAddress. + self enablePaging. +! ! + +!X86Processor methodsFor: 'paging' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageDirectory: memoryAddress + self cr3: memoryAddress +! ! + +!X86Processor methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +rdtsc + "primitiveExternalCall" + ^self primitiveFailed +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'X86Processor class' category: 'SqueakNOS-Devices-Processor'! +X86Processor class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Devices/Storage/ATABenchmarker.Class.st b/modules/NOS/Devices/Storage/ATABenchmarker.Class.st new file mode 100644 index 00000000..9213c2aa --- /dev/null +++ b/modules/NOS/Devices/Storage/ATABenchmarker.Class.st @@ -0,0 +1,173 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #ATABenchmarker category: 'SqueakNOS-Devices-Storage'! +Object subclass: #ATABenchmarker + instanceVariableNames: 'results controller' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!ATABenchmarker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: aTitle benchmark: aBlock + | startTime | + startTime := Time millisecondsToRun: aBlock. + results at: aTitle put: startTime. + + +! ! + +!ATABenchmarker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: benchTitle benchmark: aBlock size: size + | milliseconds bytesPerSecond stream | + milliseconds := Time millisecondsToRun: aBlock. + bytesPerSecond := size / milliseconds * 1000. + stream := WriteStream on: ''. + stream + nextPutAll: milliseconds asString; + nextPutAll: ' ms. Throughput: '. + (bytesPerSecond / (1024 * 1024)) asFloat absPrintOn: stream base: 10 digitCount: 5. + stream nextPutAll: ' MB/s'. + results at: benchTitle put: stream contents +! ! + +!ATABenchmarker methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +controller: aController + controller := aController. +! ! + +!ATABenchmarker methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + results := Dictionary new. + controller := ATAController primary +! ! + +!ATABenchmarker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +issueRead102400BlocksOf512Bytes + self at: 'Read 102400 blocks of 512 Bytes' benchmark: [ | offset | offset := 0. + 102400 timesRepeat: [ + controller issueReadFrom: offset count: 1 device: 0 timeout: 5000. + offset := offset + 1. + ] + ] size: 102400 * 512. + + +! ! + +!ATABenchmarker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +issueRead1024BlocksOf4KB + | read magic | + + self + at: 'Read 1024 blocks of 4 KB' + benchmark: [ | offset | + offset := 0. + 1024 + timesRepeat: [ read := controller + issueReadFrom: offset + count: 8 + device: 0 + timeout: 5000. + offset = 0 + ifTrue: [ magic := read unsignedShortAt: 511 ]. + offset := offset + 8 ] ] + size: 1024 * 8 * 512. + self validateResult: magic +! ! + +!ATABenchmarker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +issueRead1024BlocksOf64KB + | read magic | + self + at: 'Read 1024 blocks of 64 KB' + benchmark: [ | offset | + offset := 0. + 1024 + timesRepeat: [ read := controller + issueReadFrom: offset + count: 128 + device: 0 + timeout: 5000. + offset = 0 + ifTrue: [ magic := read unsignedShortAt: 511 ]. + offset := offset + 128 ] ] + size: 1024 * 128 * 512. + self validateResult: magic +! ! + +!ATABenchmarker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +issueRead1BlockOf50MB + | magic | + self + at: 'Read 1 block of 50 MB' + benchmark: [ magic := (controller at: 1 count: 102400 of: 0) unsignedShortAt: 511 ] + size: 102400 * 512. + self validateResult: magic +! ! + +!ATABenchmarker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +issueWrite102400BlocksOf512Bytes + | array | + array := ByteArray new: 512. + self at: 'Write 102400 blocks of 512 Bytes' benchmark: [ | offset | offset := 0. + 102400 timesRepeat: [ + controller issueWrite: array at: offset device: 0 timeout: 5000. + offset := offset + 1. + ] + ] size: 102400 * 512 + + +! ! + +!ATABenchmarker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +issueWrite1024BlocksOf50KB + | array | + array := ByteArray new: 50*1024. + self at: 'Write 1024 blocks of 50 KB' benchmark: [ | offset | offset := 0. + 1024 timesRepeat: [ + controller issueWrite: array at: offset device: 0 timeout: 5000. + offset := offset + 100. + ] + ] size: 102400 * 512 + + +! ! + +!ATABenchmarker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +issueWrite1BlockOf50MB + | array | + array := ByteArray new: 50*1024*1024. + self at: 'Write 1 block of 50 MB' benchmark: [ + controller at: 1 of: 0 putAll: array. + ] size: 102400 * 512 + + +! ! + +!ATABenchmarker methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +run + self issueWrite1BlockOf50MB. + self issueRead1BlockOf50MB. + self issueWrite1024BlocksOf50KB. + self issueRead1024BlocksOf50KB. +! ! + +!ATABenchmarker methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +runRead + self issueRead1BlockOf50MB; + issueRead1024BlocksOf64KB; + issueRead1024BlocksOf4KB +! ! + +!ATABenchmarker methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +validateResult: magic + magic = 16rAA55 ifFalse: [ self error: 'read failed' ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ATABenchmarker class' category: 'SqueakNOS-Devices-Storage'! +ATABenchmarker class + instanceVariableNames: ''! + + +ATABenchmarker initialize! + diff --git a/modules/NOS/Devices/Storage/ATAController.Class.st b/modules/NOS/Devices/Storage/ATAController.Class.st new file mode 100644 index 00000000..f668605b --- /dev/null +++ b/modules/NOS/Devices/Storage/ATAController.Class.st @@ -0,0 +1,973 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #ATAController category: 'SqueakNOS-Devices-Storage'! +PCIDevice subclass: #ATAController + instanceVariableNames: 'control busMaster buffer done busy transferReady transferReadyBool interruptController bytes' + classVariableNames: 'primary secondary' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!ATAController commentStamp: '' prior: 0! + +First reference is this: + +http://www.repairfaq.org/filipg/LINK/F_IDE-tech.html + +But it contains some errors/simplifications, particularly about LBA addressing, so I recomend +reading this too: + +http://www.t13.org/Documents/UploadedDocuments/project/d0791r4c-ATA-1.pdf + +ATA Specification defines a set of registers that are used to communicate with a hard disk controller. Each controller controls at most two hard disks: a master and a slave. Most +commands issued in these registers apply to the controller's selected disk (master or slave). + ++----+------+------+---+---+---+----------------+---------------+ +|Addr|-CS1FX|-CS3FX|SA2|SA1|SA0| Read (-IOR) | Write (-IOW) | ++----+------+------+---+---+---+----------------+---------------+-----------+ +| | 0 | 0 | X | X | X | ILLEGAL | ILLEGAL | <--+ | +| | 1 | 1 | X | X | X | High Impedance | Not Used | Control | +|3FX | 1 | 0 | 0 | X | X | High Impedance | Not Used | Block | +|3FX | 1 | 0 | 1 | 0 | X | High Impedance | Not Used | Registers | +|3F6 | 1 | 0 | 1 | 1 | 0 | Altern Status | Device Control| | | +|3F7 | 1 | 0 | 1 | 1 | 1 | Drive Address | Not Used | <--+ | ++----+------+------+---+---+---+----------------+---------------+-----------+ +|1F0 | 0 | 1 | 0 | 0 | 0 | Data Port | Data Port | <--+ | +|1F1 | 0 | 1 | 0 | 0 | 1 | Error Register | Features | | | +|1F2 | 0 | 1 | 0 | 1 | 0 | Sector Count | Sector Count | Command | +|1F3 | 0 | 1 | 0 | 1 | 1 | Sector Number | Sector Number | Block | +|1F4 | 0 | 1 | 1 | 0 | 0 | Cylinder Low | Cylinder Low | Registers | +|1F5 | 0 | 1 | 1 | 0 | 1 | Cylinder High | Cylinder High | | | +|1F6 | 0 | 1 | 1 | 1 | 0 | Drive / Head | Drive / Head | | | +|1F7 | 0 | 1 | 1 | 1 | 1 | Status | Command | <--+ | ++----+------+------+---+---+---+----------------+---------------+-----------+ + +1F0: Read/Write: DATA PORT REGISTER +1F1: Read: ERROR REGISTER +1F1: Write: FEATURES +1F2: Read/Write: SECTOR COUNT REGISTER +1F3: Read/Write: SECTOR NUMBER REGISTER +1F4: Read/Write: CYLINDER LOW REGISTER +1F5: Read/Write: CYLINDER HIGH REGISTER +1F6: Read/Write: DRIVE/HEAD REGISTER (rrrDHHHH) +1F7: Read: STATUS REGISTER +1F7: Write: COMMAND REGISTER + + mov dx,1f6h ;Drive and head port + mov al,0a0h ;Drive 0, head 0 + out dx,al + + mov dx,1f2h ;Sector count port + mov al,1 ;Read one sector + out dx,al + + mov dx,1f3h ;Sector number port + mov al,1 ;Read sector one + out dx,al + + mov dx,1f4h ;Cylinder low port + mov al,0 ;Cylinder 0 + out dx,al + + mov dx,1f5h ;Cylinder high port + mov al,0 ;The rest of the cylinder 0 + out dx,al + + mov dx,1f7h ;Command port + mov al,20h ;Read with retry. + out dx,al +still_going: + in al,dx + test al,8 ;This means the sector buffer requires +! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +at2: startSector count: sectorCount of: deviceNumber + | remaining alreadyRead nextBlockNumber | + "The max we can read is 256 sectors (thats an ATA limit). If we want to read more, we do it by grabing chunks of 256 sectors until we finish." + "Transcript show: 'Reading from: ', firstBlockNumber asString, ' to: ', lastBlockNumber asString, Character cr asString." + "self halt." + remaining := sectorCount. + alreadyRead := 0. + nextBlockNumber := startSector - 1. + [ remaining > 0 ] + whileTrue: [ | chunkSize | + chunkSize := remaining min: 256. + self + issueReadFrom: nextBlockNumber + count: chunkSize + device: deviceNumber + timeout: self readMillisecondsTimeout. + nextBlockNumber := nextBlockNumber + chunkSize. + alreadyRead := alreadyRead + 256. + remaining := remaining - 256 ]. +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: startSector count: sectorCount of: deviceNumber + + | answer | + answer := ByteArray new: sectorCount * self sectorSize. + self at: startSector count: sectorCount of: deviceNumber into: answer. + ^answer + +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: startSector count: sectorCount of: deviceNumber into: answer + | remaining alreadyRead nextBlockNumber start size | + "The max we can read is 256 sectors (thats an ATA limit). If we want to read more, we do it by grabing chunks of 256 sectors until we finish." + "Transcript show: 'Reading from: ', firstBlockNumber asString, ' to: ', lastBlockNumber asString, Character cr asString." + "self halt." + answer unsignedLongAt: 1 put: 16r55AA66BB. + remaining := sectorCount. + alreadyRead := 0. + nextBlockNumber := startSector - 1. + [ remaining > 0 ] + whileTrue: [ | chunkSize | + chunkSize := remaining min: 256. + start := self byteOffsetOfBlock: alreadyRead + 1. + size := chunkSize * self blockSize. + self + issueReadFrom: nextBlockNumber + count: chunkSize + device: deviceNumber + timeout: self readMillisecondsTimeout. + buffer fillInto: answer at: start size: size. + nextBlockNumber := nextBlockNumber + chunkSize. + alreadyRead := alreadyRead + 256. + remaining := remaining - 256 ]. + ^ answer +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: firstSectorNumber of: aDeviceNumber putAll: aByteArray + | nextSectorNumber | + nextSectorNumber := firstSectorNumber - 1. "Decrement 1 because block num comes 1-based and LBA indexes are 0-based" + self groupsOfMax: 256 * 512 atATimeIn: aByteArray do: [ :sectorContents | + self + issueWrite: sectorContents + at: nextSectorNumber + device: aDeviceNumber + timeout: self writeMillisecondsTimeout. + nextSectorNumber := nextSectorNumber + 256. + ]. + + + + +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atAlternateStatusReg + ^ control uByteAtOffset: 0 +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atCommandRegPut: aSmallInteger + "When the host request a command it is transferred to the hard drive through an eight bit code written to the command register. As soon as the drive receives a command in its command register, it begins execution of the command. The following table lists the commands in alphabetical order and the parameters for each executable command:" + + ^ self byteAt: 7 put: aSmallInteger + + " + +--------+---------------------------------+-----------------+ + | Command| Command Description | Parameters Used + | Code | | PC SC SN CY DH + +--------+---------------------------------+-----------------+ + | 98h @ | Check Power Mode | V D + | E5h @ | Check Power Mode (same as 98h) | V D + | 90h | Execute Drive Diagnostic | D+ + | 50h | Format Track | V V + | ECh @ | Identify Drive | D + | 97h @ | Idle | V D + | E3h @ | Idle (same as 97h) | V D + | 95h @ | Idle Immediate | D + | E1h @ | Idle Immadiate (same as 95h) | D + | 91h | Initialize Drive Parameters | V V + | E4h @ | Read Buffer | D + | C8h @ | Read DMA With Retry | >> Unknown << + | C9h @ | Read DMA | >> Unknown << + | C4h @ | Read Multiple | V V V V + | 20h | Read Sectors With Retry | V V V V + | 21h | Read Sectors | V V V V + | 22h | Read Long With Retry | V V V V + | 23h | Read Long | V V V V + | 40h | Read Verify Sectors With Retry | V V V V + | 41h | Read Verify Sectors | V V V V + | 1Xh | Recalibrate | D + | 7Xh | Seek | V V + | EFh @ | Set Features | V D + | C6h @ | Set Multiple Mode | V D + | 99h @ | Set Sleep Mode | D + | E6h @ | Set Sleep Mode (same as 99h) | D + | 96h @ | Standby | V D + | E2h @ | Standby (same as 96h) | V D + | 94h @ | Standby Immediate | D + | E0h @ | Standby Immediate (same as 94h) | D + | 8Xh | Vendor Unique | >> Unknown << + | 9Ah | Vendor Unique | >> Unknown << + | C0h | Vendor Unique | >> Unknown << + | C1h | Vendor Unique | >> Unknown << + | C2h | Vendor Unique | >> Unknown << + | C3h | Vendor Unique | >> Unknown << + | F5h | Vendor Unique | >> Unknown << + | F6h | Vendor Unique | >> Unknown << + | F7h | Vendor Unique | >> Unknown << + | F8h | Vendor Unique | >> Unknown << + | F9h | Vendor Unique | >> Unknown << + | FAh | Vendor Unique | >> Unknown << + | FBh | Vendor Unique | >> Unknown << + | FCh | Vendor Unique | >> Unknown << + | FDh | Vendor Unique | >> Unknown << + | FEh | Vendor Unique | >> Unknown << + | FFh | Vendor Unique | >> Unknown << + | E8h @ | Write Buffer | D + | CAh @ | Write DMA With Retry | >> Unknown << + | CBh @ | Write DMA | >> Unknown << + | C5h @ | Write Multiple | V V V V + | E9h @ | Write Same | >> Unknown << + | 30h | Write Sectors With Retry | V V V V + | 31h | Write Sectors | V V V V + | 32h | Write Long With Retry | V V V V + | 33h | Write Long | V V V V + | 3Ch @ | Write Verify | V V V V + +--------+---------------------------------+-----------------+ + " +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atCylinderHighReg + ^ self byteAt: 5 +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atCylinderHighRegPut: aSmallInteger + ^ self byteAt: 5 put: aSmallInteger +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atCylinderLowReg + ^ self byteAt: 4 +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atCylinderLowRegPut: aSmallInteger + ^ self byteAt: 4 put: aSmallInteger +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atDataPortRegRead: anAmount + "Read amount of shorts from data register." + ^ self shortStringAt: 0 size: anAmount. +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atDataPortRegWrite: aString + ^ self shortStringAt: 0 put: aString +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atDeviceControRegPut: anInteger + ^ control uByteAtOffset: 0 + 1put: anInteger +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atDriveHeadReg + "Drive/Head head register, Offset 6, 8 bits. + This register contains the drive and head numbers. The contents of this + register define the number of heads minus 1, when executing an Initialize + Drive Parameters command. + + Upon command completion this register is updated to refplect the head number currently + selected. + " + + ^ self byteAt: 6. + + " + +-----------------------------------------+ + | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 | + |---+---+---+-----+-----+-----+-----+-----| + | 1 | L | 1 | DRV | HS3 | HS2 | HS1 | HS0 | + +-----------------------------------------+ + + - L is the binary encoded address mode select. When L=0, addressing is + by CHS mode. When L=1, addressing is by LBA mode. + - DRV is the binary encoded drive select number. When DRV-0, Drive 0 is + selected. When DRV=1, Drive 1 is selected. + - If L=0, HS3 through HS0 contain the binary coded address of the head to + be selected e.g., if HS3 through HS0 are 0011b, respectively, head 3 + will be selected. HS3 is the most significant bit. At command + completion, these bits are updated to reflect the currently selected + head. + - If L=1, HS3 through HS0 contain bits 24-27 of the LBA. At command + completion, these bits are updated to reflect the current LBA bits + 24-27. + " +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atDriveHeadRegPut: aValue + "Drive/Head head register, Offset 6, 8 bits. + This register contains the drive and head numbers. The contents of this + register define the number of heads minus 1, when executing an Initialize + Drive Parameters command. + + Upon command completion this register is updated to refplect the head number currently + selected. + " + ^ self byteAt: 6 put: aValue. + + " + +-----------------------------------------+ + | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 | + |---+---+---+-----+-----+-----+-----+-----| + | 1 | L | 1 | DRV | HS3 | HS2 | HS1 | HS0 | + +-----------------------------------------+ + + - L is the binary encoded address mode select. When L=0, addressing is + by CHS mode. When L=1, addressing is by LBA mode. + - DRV is the binary encoded drive select number. When DRV-0, Drive 0 is + selected. When DRV=1, Drive 1 is selected. + - If L=0, HS3 through HS0 contain the binary coded address of the head to + be selected e.g., if HS3 through HS0 are 0011b, respectively, head 3 + will be selected. HS3 is the most significant bit. At command + completion, these bits are updated to reflect the currently selected + head. + - If L=1, HS3 through HS0 contain bits 24-27 of the LBA. At command + completion, these bits are updated to reflect the current LBA bits + 24-27. + " + +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atSectorNumberReg + ^ self byteAt: 3 +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atSectorNumberRegPut: aSmallInteger + ^ self byteAt: 3 put: aSmallInteger +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +atStatusReg + "Contains information about the status of the drive and controller. The contents of + this register are updated at the completion of each command. When the busy bit + is set, no other bits in the Command Block Registers are valid. When the busy bit + is not set, the information in the Status Register and Command Block Registers is valid." + + ^ self byteAt: 7 + + " + +-----+----------+----------------------------------------------------------+ + | BIT | Mnemonic | Description + +-----+----------+----------------------------------------------------------+ + | 7 | BUSY | Busy bit. Set by the controller logic of the drive when + | | | ever the drive has access to and the host is locked out + | | | of the Command Block Registers. Set under the following + | | | conditions: + | | | o Within 400 nsec after the negation of RESET or after + | | | SRST is set in the Device Control Register. After a + | | | reset it is recomended that BUSY be set no more than + | | | 30 seconds. + | | | o Within 400 nsec of a host write to the Command + | | | Register with a Recalibrate, Read Long, Read Buffer, + | | | Read, Read Verify, Initialize Drive Parameters, Seek + | | | Identify Drive, or Execute Drive Diagnostic command. + | | | o Within 5 microseconds following the transfer of 512 + | | | bytes of data during the execution of a Write, Write + | | | Buffer or Format Track command; or 512 bytes of data + | | | and the appropriate number of ECC bytes during the + | | | execution of a Write Long command. + | | | When BUSY is set no Command Block Register can be + | | | written too and a read of any Command Block Register + | | | returns the contents of the Status Register. + | | | + | 6 | DRDY | Drive Ready bit. Indicates that the drive is ready to + | | | accept commands. When and error occurs, this bit stays + | | | unchanged until the host reads the Status Register then + | | | again indicates that hte drive is ready. On power up, + | | | this bit should be cleared and should remain cleared + | | | until the drive is up to speed and ready to accept a + | | | command. + | | | + | 5 | DWF | Drive Write Fault bit. When an error occurs, this bit + | | | remains unchanged until the host reads the Status + | | | Register, then again indicates the current write fault + | | | status. + | | | + | 4 | DSC | Drive Seek Complete bit. This bit is set when a seek + | | | operation is complete and the heads are settled over a + | | | track. When an error occurs, this bit remains unchanged + | | | until the host reads the Status Register, then again it + | | | indicates the current seek complete status. + | | | + | 3 | DRQ | Data Request bit. When set it indicates that the drive + | | | is ready to transfer a word or byte of data between the + | | | host and the data port. + | | | + | 2 | CORR | Corrected Data bit. When a correctable data error has + | | | been encountered and the data has been corrected, this + | | | bit is set. This condition does not terminate a multi + | | | sector read operation. + | | | + | 1 | INDEX | Index bit. Set when the index mark is detected once per + | | | disk revolution. + | | | + | 0 | ERROR | Error bit. When set indicates that the previous command + | | | ended in an error. The other bits in the Error Register + | | | and Status Register contain additional information about + | | | the cause of the error. + +-----+----------+----------------------------------------------------------+ + " +! ! + +!ATAController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +blockSize + ^512 +! ! + +!ATAController methodsFor: 'status/testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +busy: aStatus + ^ aStatus anyMask: 128. +! ! + +!ATAController methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +byteOffsetOfBlock: aBlockNumber + "Returns the position of the first byte of the block" + ^ aBlockNumber - 1 * self blockSize + 1. +! ! + +!ATAController methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +cmdDeviceReset + ^ self atCommandRegPut: 16r08 +! ! + +!ATAController methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +cmdIdentifyDevice + ^ self atCommandRegPut: 16rEC +! ! + +!ATAController methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +cmdReadSectors + ^ self atCommandRegPut: 16r21 +! ! + +!ATAController methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +cmdReadSectorsDMA + ^ self atCommandRegPut: 16rC9 +! ! + +!ATAController methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +cmdReadSectorsDMAWithRetry + ^ self atCommandRegPut: 16rC8 +! ! + +!ATAController methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +cmdReadSectorsWithRetry + ^ self atCommandRegPut: 16r20 +! ! + +!ATAController methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +cmdWriteSectorsWithRetry + ^ self atCommandRegPut: 16r30 +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +consumeUselessInterrupt + self atStatusReg. + transferReadyBool := false + "transferReady wait." +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +control + ^control +! ! + +!ATAController methodsFor: 'status/testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +dataReady: aStatus + ^ aStatus anyMask: 8. +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableInterrupts + ^ self atDeviceControRegPut: 2r00000010 +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +doReadSectors: sectorCount + | result | + result := self + cmdReadSectors; + readAllAvailable: sectorCount. + self reenableIRQsAndCheckForErrors. + ^result + + +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +doReadSectorsDMA: sectorCount + | size offset | + size := sectorCount * self sectorSize. + self cmdReadSectorsDMAWithRetry. + offset := busMaster offset. + busMaster + setupTransferOf: size with: buffer; + issueRead. + self waitUntilTransferIsReady. + busMaster + stopTransfer; + resetDescriptorTable. + self reenableIRQsAndCheckForErrors. + ^buffer +! ! + +!ATAController methodsFor: 'status/testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +driveReady: aStatus + ^ aStatus anyMask: 64. +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableInterrupts + ^ self atDeviceControRegPut: 0 +! ! + +!ATAController methodsFor: 'status/testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +errorOccurred: aStatus + ^ aStatus anyMask: 1. +! ! + +!ATAController methodsFor: 'status/testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +errorsDidntOccur: aStatus + ^ aStatus noMask: 1. +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +from: firstSectorNumber to: lastSectorNumber device: aDeviceNumber + ^ self at: firstSectorNumber count: lastSectorNumber - firstSectorNumber + 1 of: aDeviceNumber. +! ! + +!ATAController methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +groupsOf: n atATimeIn: aByteArray do: aBlock + "Evaluate aBlock with my elements taken n at a time. Ignore any leftovers at the end. Taken from SequenceableCollection but highly optimized." + | args | + args := ByteArray new: n. + n to: aByteArray size by: n do: [:index | + args replaceFrom: 1 + to: n + with: aByteArray + startingAt: index - n + 1. + aBlock value: args. + ] + +! ! + +!ATAController methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +groupsOfMax: n atATimeIn: aByteArray do: aBlock + "Evaluate aBlock with my elements taken n at a time. Also evaluate with leftover elements at end" + | leftover | + leftover := aByteArray size \\ n. + n + to: aByteArray size + by: n + do: [:index | + | args | + args := (aByteArray copyFrom: index - n + 1 to: index). + aBlock value: args + ]. + + (leftover > 0) ifTrue: [ + aBlock value: (aByteArray copyFrom: aByteArray size - leftover + 1 to: aByteArray size) + ]. + + +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleIRQ + "Transcript show: 'disk irq!!'." + + transferReady signal. + transferReadyBool := true. +! ! + +!ATAController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + "buffer size is large enough to handle largest ata read, which is + 256 sectors (128kb) and also aligned to 64kb for dma requirements" + + bytes := ByteArray new: 128 * 1024. + buffer := ExternalAddress allocate: 64 * 3 * 1024. + buffer fromInteger: (buffer asInteger alignedTo: 64 * 1024). + transferReady := Semaphore new. + transferReadyBool := false. + busy := Semaphore forMutualExclusion +! ! + +!ATAController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeBusMaster + | entry port | + entry := self class findPCIBusEntry. + entry enableBusMastering. + port := entry baseIOAddress: 4. + busMaster := PCIBusMaster onPort: port function: entry + + +! ! + +!ATAController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeControlBlock + | port isPrimary | + isPrimary := resource asInteger = 16r1F0. + port := isPrimary + ifTrue: [ 16r3F6 ] + ifFalse: [ 16r376 ]. + control := ExternalIOPort address: port. + self + selectDrive: 0; + resetController; + enableInterrupts; + selectDrive: 1; + enableInterrupts; + selectDrive: 0 +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + aComputer interruptController addHandler: self forIRQ: 14. +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +issueReadFrom: firstSector count: sectorCount device: deviceNumber timeout: timeout + ^ self + waitUntilNotBusyOr: timeout; + selectSector: firstSector ofDrive: deviceNumber; + regSectorCount: sectorCount; + waitUntilReadyOr: timeout; + doReadSectorsDMA: sectorCount +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +issueWrite: aByteArray at: firstSector device: deviceNumber timeout: aTimeout + "Transcript show: 'going to write ', aByteArray size printString, ' bytes: ', aByteArray asString printString, ' at: ', firstSector printString, ' + '." + self waitUntilNotBusyOr: aTimeout; + selectSector: firstSector ofDrive: deviceNumber; + regSectorCount: aByteArray size // 512; + waitUntilReadyOr: aTimeout; + cmdWriteSectorsWithRetry; + writeAllAvailable: aByteArray. + + + +! ! + +!ATAController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +lock + busy wait +! ! + +!ATAController methodsFor: 'device creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +master + ^ATADevice controlledBy: self device: 0. +! ! + +!ATAController methodsFor: 'status/testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +moreDataIsAvailable + "We should remove this method, it does the same than waitUntilDataTransferIsReady" + | status time | + time := 0. + [status := self atAlternateStatusReg. (self busy: status) & (self errorsDidntOccur: status) and: [ time < 10 ]] whileTrue: + [time := time + 1. 50000 timesRepeat: [1+1]. "(Delay forMilliseconds: 1) wait" ].. + (self errorOccurred: status) ifTrue: [self error: 'An error occurred while reading']. + time >= 10 ifTrue: [Transcript show: 'Read timeout. Status: ', status, Character cr ]. + "tells wheter data port contains more data available. This happens if:" + ^ (self dataReady: status)" & (self errorsDidntOccur: status)". +! ! + +!ATAController methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +readAllAvailable + | answer | + answer := ''. + [ self waitUntilDeviceIsReadyForTransfer ] whileTrue: [ answer := answer , self readSector ]. + answer = '' + ifTrue: [ Transcript show: 'Status: ' , self atAlternateStatusReg asString , String cr. + self error: 'Could not read anything.' ]. + ^ answer +! ! + +!ATAController methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +readAllAvailable: sectorCount + | each answer nextPosition | + each := self sectorSize. + answer := ByteArray new: sectorCount * each. + nextPosition := 1. + sectorCount timesRepeat: [ + self waitUntilDeviceIsReadyForTransfer. + answer + replaceFrom: nextPosition + to: nextPosition + self sectorSize - 1 + with: self readSector + startingAt: 1. + nextPosition := nextPosition + each ]. + ^ answer +! ! + +!ATAController methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +readMillisecondsTimeout + "Max amount of milliseconds to wait for ready status when trying to read a sector" + ^5000 +! ! + +!ATAController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +readSector + ^ self atDataPortRegRead: 512 +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +reenableIRQsAndCheckForErrors + | status | + status := self atStatusReg. + (self errorOccurred: status) ifTrue: [ self error: 'An error ocurred while transfering data' ] +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +regError + ^ self byteAt: 1 +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +regErrorClear + ^ self byteAt: 1 put: 0 +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +regSectorCount + ^ self byteAt: 2 +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +regSectorCount: aSmallInteger + "We handle special case when we want to read 256 sectors, which is done by puting a 0 in + sector count register" + aSmallInteger = 256 ifTrue: [^ self byteAt: 2 put: 0]. + ^ self byteAt: 2 put: aSmallInteger +! ! + +!ATAController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +release + busy signal +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetController + ^ self atDeviceControRegPut: 2r100 +! ! + +!ATAController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetDevice: aDriveNumber + ^self + selectDrive: aDriveNumber; + cmdDeviceReset +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorNumber + ^ self byteAt: 3 +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorNumber: aSmallInteger + ^ self byteAt: 3 put: aSmallInteger +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorSize + ^512 +! ! + +!ATAController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +selectDrive: aDriveNumber + "Select master or slave (aDriveNumber is 0 or 1 respectively). See + atDriveHeadRegPut for more details" + ^ self atDriveHeadRegPut: aDriveNumber << 4. +! ! + +!ATAController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +selectHead: aHeadNumber ofDevice: aDeviceNumber + "select head of drive. See atDriveHeadRegPut: for more details." + ^ self atDriveHeadRegPut: aDeviceNumber << 4 + aHeadNumber. +! ! + +!ATAController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +selectSector: lbaAddress ofDrive: aDriveNumber + "LBA Addressing: 28 bits. + <4 bits: head> < 8 bits: cyl high> <8 bits: cyl low> <8 bits: sector> + We add 4 to drive number so that the bit of LBA addressing mode is asserted inside selectHead. + " + + | sector cylLow cylHigh head | + sector := lbaAddress bitAnd: 16rFF. + cylLow := (lbaAddress bitShift: -8) bitAnd: 16rFF. + cylHigh := (lbaAddress bitShift: -16) bitAnd: 16rFF. + head := (lbaAddress bitShift: -24) bitAnd: 16rF. + self + selectHead: head ofDevice: aDriveNumber + 4; + regErrorClear; + atSectorNumberRegPut: sector; + atCylinderLowRegPut: cylLow; + atCylinderHighRegPut: cylHigh +! ! + +!ATAController methodsFor: 'status/testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +selectedDevice + ^ self atDriveHeadReg >> 4 bitAnd: 1. +! ! + +!ATAController methodsFor: 'status/testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +selectedHead + ^ (self shortAt: 6) bitAnd: 2r1111 +! ! + +!ATAController methodsFor: 'device creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +slave + ^ATADevice controlledBy: self device: 1. +! ! + +!ATAController methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +wait400ns + self + atAlternateStatusReg; + atAlternateStatusReg; + atAlternateStatusReg; + atAlternateStatusReg +! ! + +!ATAController methodsFor: 'status/testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitUntilDeviceIsReadyForTransfer + | status | + [ status := self atAlternateStatusReg. + (self busy: status) & (self errorsDidntOccur: status) ] whileTrue. + (self errorOccurred: status) + ifTrue: [ self error: 'An error occurred while preparing transfer' ]. + ^ self dataReady: status +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitUntilNotBusyOr: maxMilliseconds + | time status | + time := Time millisecondClockValue. + + [ status := self atStatusReg. (self busy: status) and: [ Time millisecondClockValue - time < maxMilliseconds ] ] whileTrue. + "Time millisecondClockValue - time >= maxMilliseconds ifTrue: [Transcript show: 'Not busy timeout. Status: ', status, Character cr ]." +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitUntilReadyOr: maxMilliseconds + | time status | + time := Time millisecondClockValue. + + [ status := self atAlternateStatusReg. (self driveReady: status) not and: [ Time millisecondClockValue - time < maxMilliseconds ] ] whileTrue. + + "Time millisecondClockValue - time >= maxMilliseconds ifTrue: [Transcript show: 'Ready timeout. Status: ', status, Character cr ]." +! ! + +!ATAController methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitUntilTransferIsReady + | status | + [ status := self atAlternateStatusReg. + (self busy: status) + ifFalse: [ + (self errorOccurred: status) + ifTrue: [ 'An error occurred during transfer' ] ]. + transferReadyBool ] whileFalse. + transferReadyBool := false. + "transferReady wait." + "self waitUntilNotBusyOr: 1000." +! ! + +!ATAController methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +writeAllAvailable: aByteArray + self groupsOf: 512 atATimeIn: aByteArray do: [ :sectorContents | + self waitUntilDeviceIsReadyForTransfer. + self atDataPortRegWrite: sectorContents. + ]. + +! ! + +!ATAController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +writeDataOld: source fromByte: sourceOffset atByteOffset: destOffset bytesCount: count on: aDriveNumber + "Write count bytes from source starting at startIndex bytes. We handle half sector + overwriting. Should be optimized so it doesn't write intermediate sectors (which will + be completely overwritten)." + | data sector sectorCount startOffset | + sector := self offsetToSector: destOffset. + sectorCount := (self offsetToSector: count) + 1. + data := self + regSectorCount: sectorCount; + selectSector: sector ofDrive: aDriveNumber; + cmdReadSectorsWithRetry; + readAllAvailable. + startOffset := destOffset \\ 512 + 1. + data + replaceFrom: startOffset + to: startOffset + count - 1 + with: source + startingAt: sourceOffset. + + self + regSectorCount: sectorCount; + selectSector: sector ofDrive: aDriveNumber; + cmdWriteSectorsWithRetry; + atDataPortRegWrite: data. + + ^count. +! ! + +!ATAController methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +writeMillisecondsTimeout + "Max amount of milliseconds to wait for ready status when trying to read a sector" + ^5000 +! ! + +!ATAController methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +writePrecompensation: aSmallInteger + ^ self shortAt: 1 put: aSmallInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ATAController class' category: 'SqueakNOS-Devices-Storage'! +ATAController class + instanceVariableNames: 'primary secondary'! + +!ATAController class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +findPCIBusEntry + + "IDE controller have a PCI classID = 1 (Mass storage device) and subclass 1 (IDE Mass storage device)." + + ^PCIBusEntry allValid detect: [ :entry | entry classCode = 1 and: [entry classSubCode = 1]] ifNone: [^nil]. +! ! + +!ATAController class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +onPort: portNumber + ^ (super onPort: portNumber) initializeControlBlock; initializeBusMaster +! ! + +!ATAController class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +primary + primary ifNil: [ primary := self onPort: 16r1F0 ]. + ^primary. +! ! + +!ATAController class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +secondary + secondary ifNil: [ secondary := self onPort: 16r170 ]. + ^secondary. +! ! + + +ATAController initialize! + diff --git a/modules/NOS/Devices/Storage/ATAControllerTest.Class.st b/modules/NOS/Devices/Storage/ATAControllerTest.Class.st new file mode 100644 index 00000000..6f67a2c4 --- /dev/null +++ b/modules/NOS/Devices/Storage/ATAControllerTest.Class.st @@ -0,0 +1,83 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #ATAControllerTest category: #'SqueakNOS-Devices-Storage'! +TestCase subclass: #ATAControllerTest + instanceVariableNames: 'controller' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!ATAControllerTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:24'! +selectFirstSector + controller unsignedByteAt: 6 put: 16rE0. "(slavebit << 4) | ((addr >> 24) & 0x0F));" + controller unsignedByteAt: 1 put: 16r00. + controller unsignedByteAt: 2 put: 16r01. + controller unsignedByteAt: 3 put: 0. "; addr" + controller unsignedByteAt: 4 put: 0. "; addr >> 8" + controller unsignedByteAt: 5 put: 0 "; addr >> 16" +! ! + +!ATAControllerTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:24'! +setUp + controller := ATAController primary. + +! ! + +!ATAControllerTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:24'! +test010SameStatus + | alternate regular | + + alternate := controller atAlternateStatusReg. + regular := controller atStatusReg. + self assert: alternate equals: regular +! ! + +!ATAControllerTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:24'! +test020ReadSectorRaw + "read boot sector, which ends in the magic number 0xAA55" + + | status buffer short | + self selectFirstSector. + controller unsignedByteAt: 7 put: 16r20. " ; read command" + + "wait until not busy" + [ status := controller control uByteAtOffset: 0. + (status bitAnd: 2r10000000) = 0 ] whileFalse. + + "do read" + buffer := ByteArray new: 512. + 1 to: 256 do: [ :i | + short := controller unsignedShortAt: 0. + buffer unsignedShortAt: i * 2 - 1 put: short ]. + self assert: short equals: 16rAA55 +! ! + +!ATAControllerTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:24'! +test030Read1Sector + | sector magic | + sector := controller + issueReadFrom: 0 + count: 1 + device: 0 + timeout: 1000. + magic := sector unsignedShortAt: 511. + self assert: magic equals: 16rAA55 +! ! + +!ATAControllerTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:24'! +test040ReadSectorsInBlock + | all first second third fourth | + all := controller at: 1 count: 4 of: 0. + first := controller at: 1 count: 1 of: 0. + second := controller at: 2 count: 1 of: 0. + third := controller at: 3 count: 1 of: 0. + fourth := controller at: 4 count: 1 of: 0. + self assert: all equals: first , second , third , fourth +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ATAControllerTest class' category: #'SqueakNOS-Devices-Storage'! +ATAControllerTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Devices/Storage/ATADevice.Class.st b/modules/NOS/Devices/Storage/ATADevice.Class.st new file mode 100644 index 00000000..bc0b3514 --- /dev/null +++ b/modules/NOS/Devices/Storage/ATADevice.Class.st @@ -0,0 +1,117 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #ATADevice category: 'SqueakNOS-Devices-Storage'! +BlockDevice subclass: #ATADevice + instanceVariableNames: 'controller deviceNumber cachedSector cachedSectorNumber' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!ATADevice commentStamp: '' prior: 0! + +An ATADevice is our high level representation of an ATA Hard Disk, which is a BlockDevice with blocks (sectors) of 512 bytes. It uses an ATA Controller to control the device at the lowest level. The deviceNumber is a low-level number used by the controller, where 0 means master and 1 means slave. +! + +!ATADevice methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: aBlockNumber + "Retrieve sector number aBlockNumber from device" + + ^ controller at: aBlockNumber count: 1 of: deviceNumber "Decrement 1 because block num comes 1-based and LBA indexes are 0-based" +! ! + +!ATADevice methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: firstBlockNumber count: numberOfBlocks + "Retrieve numberOfBlocks sector number aBlockNumber from device. + NumberOfBlocks should be no more than 256" + + ^ controller at: firstBlockNumber count: numberOfBlocks of: deviceNumber +! ! + +!ATADevice methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: firstBlockNumber writeArray: aByteArray + "Write aByteArray to disk starting at firstBlockNumber. aByteArray size should be multiple of the sector size" + + controller at: firstBlockNumber of: deviceNumber putAll: aByteArray +! ! + +!ATADevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +blockSize + "Answer the size of a single block" + + ^ 512 +! ! + +!ATADevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +controller + "Answer the value of controller" + + ^ controller +! ! + +!ATADevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +controller: aController + "Set the value of controller" + + controller := aController +! ! + +!ATADevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +deviceNumber + "Answer the value of deviceNumber" + + ^ deviceNumber +! ! + +!ATADevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +deviceNumber: aDeviceNumber + "Set the value of deviceNumber" + + deviceNumber := aDeviceNumber +! ! + +!ATADevice methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +from: firstBlockNumber to: lastBlockNumber + ^controller from: firstBlockNumber to: lastBlockNumber device: deviceNumber. + +! ! + +!ATADevice methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +information + "I retrieve information about this device" + | info | + info := controller + selectDrive: deviceNumber; + cmdIdentifyDevice; + readAllAvailable. + ^IDEHardDiskDeviceInformation fromHandle: info asByteArray +! ! + +!ATADevice methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +reset + "Reset the device. Useful after errors" + ^ controller resetDevice: deviceNumber. + +! ! + +!ATADevice methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +size + ^self information sectorsExtended + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ATADevice class' category: 'SqueakNOS-Devices-Storage'! +ATADevice class + instanceVariableNames: ''! + +!ATADevice class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +controlledBy: aController device: aDeviceNumber + loadedDevices ifNil: [ loadedDevices := Dictionary new ]. + (loadedDevices at: aController + ifAbsentPut: [ Dictionary new ]) + at: aDeviceNumber + ifAbsentPut: [self new controller: aController; deviceNumber: aDeviceNumber]. + ^(loadedDevices at: aController) at: aDeviceNumber. +! ! + + diff --git a/modules/NOS/Devices/Storage/ATARawController.Class.st b/modules/NOS/Devices/Storage/ATARawController.Class.st new file mode 100644 index 00000000..20e1f3d5 --- /dev/null +++ b/modules/NOS/Devices/Storage/ATARawController.Class.st @@ -0,0 +1,105 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #ATARawController category: #'SqueakNOS-Devices-Storage'! +PCIDevice subclass: #ATARawController + instanceVariableNames: 'control busMaster semaphore buffer done interrupted' + classVariableNames: 'primary secondary' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!ATARawController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleIRQ + interrupted := true +! ! + +!ATARawController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + | port | + interrupted := false. + buffer := ExternalAddress allocate: 128 * 1024. + buffer fromInteger: (buffer asInteger alignedTo: 64 * 1024). + + control := ExternalIOPort address: 16r3F6. + port := ATAController findPCIBusEntry baseIOAddress: 4. + busMaster := ExternalIOPort address: port. + Computer current interruptController addHandler: self forIRQ: 14. + self unsignedByteAt: 6 put: 0. "select disk" + control uByteAtOffset: 1 put: 2r00001000 "clearing nIEN bit" +! ! + +!ATARawController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +readSector + | short status | + self unsignedByteAt: 6 put: 16rE0. "(slavebit << 4) | ((addr >> 24) & 0x0F));" + self unsignedByteAt: 1 put: 16r00. + self unsignedByteAt: 2 put: 16r01. + self unsignedByteAt: 3 put: 0. "; addr" + self unsignedByteAt: 4 put: 0. "; addr >> 8" + self unsignedByteAt: 5 put: 0. "; addr >> 16" + "self unsignedByteAt: 7 put: 0x30" "; write command" + self unsignedByteAt: 7 put: 16r20. " ; read command" + "wait 400ns" + control + unsignedByteAt: 1; + unsignedByteAt: 1; + unsignedByteAt: 1; + unsignedByteAt: 1. + "wait until not busy" + [ status := control uByteAtOffset: 0. + (status bitAnd: 2r10000000) = 0 ] whileFalse. + + "do read" + buffer := ByteArray new: 512. + 1 to: 256 do: [ :i | + short := self unsignedShortAt: 0. + buffer unsignedShortAt: i * 2 - 1 put: short ]. + ^ buffer +! ! + +!ATARawController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +readSectorDMA + | command status o | + self selectFirstSector. + self unsignedByteAt: 7 put: 16rC8. " ; read DMA command" + buffer unsignedLongAt: 1 put: buffer asInteger + 16r1000. + buffer unsignedLongAt: 5 put: 16r80000200. "size + end-of-transfer" + + "clear start/stop bit" + command := busMaster unsignedByteAt: 0 + 1. + busMaster unsignedByteAt: 0 + 1 put: (command bitAnd: 16rFE). + busMaster unsignedLongAt: 4 + 1 put: buffer asInteger. "set prdt" + + "set read bit" + command := busMaster unsignedByteAt: 0 + 1. + busMaster unsignedByteAt: 0 + 1 put: (command bitOr: 8). + + "clear interrupt and error status" + status := busMaster unsignedByteAt: 2 + 1. + busMaster unsignedByteAt: 2 + 1 put: (status bitAnd: 16rF3). + + "set start/stop bit" + command := busMaster unsignedByteAt: 0 + 1. + busMaster unsignedByteAt: 0 + 1 put: (command bitOr: 1). + o := OrderedCollection new. + [ interrupted ] whileFalse: [ o add: 1; removeFirst ] +! ! + +!ATARawController methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +selectFirstSector + self unsignedByteAt: 6 put: 16rE0. "(slavebit << 4) | ((addr >> 24) & 0x0F));" + self unsignedByteAt: 1 put: 16r00. + self unsignedByteAt: 2 put: 16r01. + self unsignedByteAt: 3 put: 0. "; addr" + self unsignedByteAt: 4 put: 0. "; addr >> 8" + self unsignedByteAt: 5 put: 0. "; addr >> 16" + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ATARawController class' category: #'SqueakNOS-Devices-Storage'! +ATARawController class + instanceVariableNames: 'primary secondary'! + + +ATARawController initialize! + diff --git a/modules/NOS/Devices/Storage/ATATest.Class.st b/modules/NOS/Devices/Storage/ATATest.Class.st new file mode 100644 index 00000000..af891d9c --- /dev/null +++ b/modules/NOS/Devices/Storage/ATATest.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #ATATest category: #'SqueakNOS-Devices-Storage'! +TestCase subclass: #ATATest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ATATest class' category: #'SqueakNOS-Devices-Storage'! +ATATest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Devices/Storage/BlockDevice.Class.st b/modules/NOS/Devices/Storage/BlockDevice.Class.st new file mode 100644 index 00000000..43076a9a --- /dev/null +++ b/modules/NOS/Devices/Storage/BlockDevice.Class.st @@ -0,0 +1,275 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #BlockDevice category: 'SqueakNOS-Devices-Storage'! +Object subclass: #BlockDevice + instanceVariableNames: 'cache' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!BlockDevice commentStamp: '' prior: 0! + +A BlockDevice is an <> that represents a device that is accessed by block index. Maybe it should subclass ArrayedCollection and not Object. It implements a veeeeery primitive caching mechanism. + +ATADevice is an example of a block device. +! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: aBlockNumber + ^ self subclassResponsibility +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: aBlockNumber write: aBlock + ^ self subclassResponsibility +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +at: aBlockNumber writeArray: aByteArray + ^ self subclassResponsibility +! ! + +!BlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +blockNumberFromByteIndex: anInteger + + ^anInteger - 1 // self blockSize + 1. +! ! + +!BlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +blockSize + "Answer the size of a single block" + ^ self subclassResponsibility. +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +byteAt: anInteger + "blockNumberFromByteOffset: is 1-based" + | blockNumber blockOffset | + blockNumber := self blockNumberFromByteIndex: anInteger. + blockOffset := anInteger - 1 \\ 512. + ^self byteAtBlock: blockNumber offset: blockOffset. + +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +byteAt: anInteger put: value + | byte | + (value < 0 or: [ value > 255 ]) ifTrue: [ self halt ]. + byte := ByteArray with: value. + ^self replaceFromByte: anInteger bytesCount: 1 with: byte startingAtByte: 1 + +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +byteAtBlock: blockNumber offset: blockOffset + ^(self at: blockNumber) at: blockOffset + 1 + +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +byteAtOffset: offset + ^self byteAt: offset + 1 +! ! + +!BlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +bytesAt: index count: bytesCount + ^self fromByte: index bytesCount: bytesCount + +! ! + +!BlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableCache + cache flushWrites. + cache := NullBlockCache on: self. +! ! + +!BlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCache + cache flushWrites. + cache := BlockCache on: self. +! ! + +!BlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +flush + + cache flushWrites. +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +from: firstBlockNumber to: lastBlockNumber + "returns a bytearray containing all blocks from firstBlockNumber to lastBlockNumber included. Block number is a 1-based index." + ^ self subclassResponsibility. + +! ! + +!BlockDevice methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromByte: byteIndex bytesCount: bytesCount + | data firstBlock lastBlock firstBlockBytesOffset | + firstBlock := self blockNumberFromByteIndex: byteIndex. + lastBlock := self blockNumberFromByteIndex: byteIndex + bytesCount - 1. + data := self from: firstBlock to: lastBlock. + firstBlockBytesOffset := (byteIndex - 1) \\ 512 + 1. + ^ data copyFrom: firstBlockBytesOffset to: firstBlockBytesOffset + bytesCount - 1 +! ! + +!BlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromByte: firstByte toByte: lastByte + + | data firstBlock lastBlock firstBlockBytesOffset | + firstBlock := self blockNumberFromByteIndex: firstByte. + lastBlock := self blockNumberFromByteIndex: lastByte. + + data := self from: firstBlock to: lastBlock. + + firstBlockBytesOffset := self positionInBlockOf: firstByte. + ^ data copyFrom: firstBlockBytesOffset to: firstBlockBytesOffset + lastByte - firstByte. + +! ! + +!BlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + cache := ReadBlockCache on: self + +! ! + +!BlockDevice methodsFor: 'filesystem' stamp: 'KenD 28/Jun/2026 13:32:24'! +masterBootRecord + ^ MasterBootRecord on: (self at: 1) +! ! + +!BlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +oldreplaceFromByte: destOffset bytesCount: bytesCount with: source startingAtByte: sourceOffset + "Write count bytes from source starting at startIndex bytes. We handle half sector + overwriting." + | data firstBlock lastBlock blocksCount firstBlockBytesOffset lastBlockBytesCount blockData firstSectorRead | + + firstBlock := self blockNumberFromByteIndex: destOffset. + lastBlock := self blockNumberFromByteIndex: destOffset + bytesCount - 1. + blocksCount := lastBlock - firstBlock + 1. + + firstSectorRead := false. + + data := ByteArray new: blocksCount * self blockSize. + + cache := Array new: 3. + + "If it starts at block boundaries, we don't need to read the block. We'll probably overwrite it entirely" + firstBlockBytesOffset := self positionInBlockOf: destOffset. + firstBlockBytesOffset ~= 1 ifTrue: [ + firstSectorRead := true. + blockData := self at: firstBlock. + data replaceFrom: 1 to: self blockSize with: blockData startingAt: 1. + ]. + + "If it ends at block boundaries, we don't need to read the last block. We'll probably overwrite it entirely" + lastBlockBytesCount := self positionInBlockOf: destOffset + bytesCount - 1. + lastBlockBytesCount ~= self blockSize ifTrue: [ + (blocksCount = 1 & firstSectorRead) ifFalse: [ + blockData := self at: lastBlock. + data replaceFrom: 1 to: self blockSize with: blockData startingAt: 1. + ]. + ]. + + data + replaceFrom: firstBlockBytesOffset to: (firstBlockBytesOffset + bytesCount - 1) + with: source startingAt: sourceOffset. + + self at: firstBlock writeArray: data. + +! ! + +!BlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +positionInBlockOf: aByteOffset + ^ aByteOffset - 1 \\ self blockSize + 1. +! ! + +!BlockDevice methodsFor: 'filesystem' stamp: 'KenD 28/Jun/2026 13:32:24'! +primaryFilesystem + | mbr record segment bytes | + mbr := self masterBootRecord. + 1 to: 4 do: [ :i | + record := mbr partitionRecord: i. + segment := record partitionSegmentOn: self. + bytes := ByteArrayOnBlockDevice on: segment. + "FIXME: check if it is a fat32 partition" + ^ (FAT32FileSystem on: bytes) open ] +! ! + +!BlockDevice methodsFor: 'filesystem' stamp: 'KenD 28/Jun/2026 13:32:24'! +primaryPartition + | mbr record segment | + mbr := self masterBootRecord. + record := mbr partitionRecord: 1. + segment := record partitionSegmentOn: self. + ^ByteArrayOnBlockDevice on: segment. + +! ! + +!BlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +readInto: byteArray startWritingAtByte: destOffset startReadingAtByte: sourceOffset bytesCount: bytesCount + + | firstBlock lastBlock firstBlockBytesOffset | + firstBlock := self blockNumberFromByteIndex: sourceOffset. + lastBlock := self blockNumberFromByteIndex: sourceOffset + bytesCount - 1. + + firstBlockBytesOffset := self positionInBlockOf: sourceOffset. + byteArray replaceFrom: destOffset to: destOffset + bytesCount - 1 with: (cache from: firstBlock to: lastBlock) startingAt: firstBlockBytesOffset. + ^bytesCount. + + + +! ! + +!BlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +replaceFromByte: destOffset bytesCount: bytesCount with: source startingAtByte: sourceOffset + "Write count bytes from source starting at startIndex bytes. We handle half sector + overwriting." + cache replaceFromByte: destOffset bytesCount: bytesCount with: source startingAtByte: sourceOffset. +! ! + +!BlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:24'! +segmentFrom: start size: size + ^BlockDeviceSegment on: self from: start to: start + size - 1 +! ! + +!BlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:24'! +sizeInBytes + ^self size * self blockSize +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedLongAt: anInteger + ^ (self bytesAt: anInteger count: 4) unsignedLongAt: 1 +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedLongAt: anInteger put: value + | long | + (value < 0 or: [ value >= 16r100000000 ]) ifTrue: [ self halt ]. + long := ByteArray with: (value digitAt: 1) with: (value digitAt: 2) with: (value digitAt: 3) with: (value digitAt: 4). + ^self replaceFromByte: anInteger bytesCount: 4 with: long startingAtByte: 1 + +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedShortAt: anInteger + ^ (self bytesAt: anInteger count: 2) unsignedShortAt: 1 +! ! + +!BlockDevice methodsFor: 'real access' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedShortAt: anInteger put: value + | short | + (value < 0 or: [ value >= 16r10000 ]) ifTrue: [ self halt ]. + short := ByteArray with: (value digitAt: 1) with: (value digitAt: 2). + ^self replaceFromByte: anInteger bytesCount: 2 with: short startingAtByte: 1 + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockDevice class' category: 'SqueakNOS-Devices-Storage'! +BlockDevice class + instanceVariableNames: ''! + + +BlockDevice initialize! + diff --git a/modules/NOS/Devices/Storage/BlockDeviceTest.Class.st b/modules/NOS/Devices/Storage/BlockDeviceTest.Class.st new file mode 100644 index 00000000..d52703b0 --- /dev/null +++ b/modules/NOS/Devices/Storage/BlockDeviceTest.Class.st @@ -0,0 +1,122 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #BlockDeviceTest category: #'SqueakNOS-Devices-Storage'! +TestCase subclass: #BlockDeviceTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!BlockDeviceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +fill: aByteArray + 1 to: 512 do: [ :i | aByteArray at: i put: i \\ 256 ]. +! ! + +!BlockDeviceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +test005Creation + self shouldnt: [ATAController primary master] raise: Error. + self shouldnt: [ATAController secondary slave] raise: Error. + +! ! + +!BlockDeviceTest methodsFor: 'objects' stamp: 'KenD 28/Jun/2026 13:32:24'! +testDevice + "Should warn that this will read and WRITE secondary slave hard disk" + ^ ATAController secondary slave. +! ! + +!BlockDeviceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testImageSaving + | image collection raw tester cache bytes strm1 strm2 sizeToTest | + image := StandardFileStream fileNamed: SmalltalkImage current imageName. + sizeToTest := 1000000. + bytes := (image next: sizeToTest) asByteArray. + collection := OrderedCollection new: sizeToTest. + strm1 := ReadWriteStream on: collection. + strm2 := ReadWriteStream on: collection copy. + cache := BlockDeviceOnStream on: strm1 blockSize: 512. + cache enableCache. + raw := BlockDeviceOnStream on: strm2 blockSize: 512. + tester := DualTestBlockDevice deviceA: cache deviceB: raw. + tester at: 1 writeArray: bytes; flush. + self assert: (tester fromByte: 1 bytesCount: bytes size) asByteArray = bytes. + image close + +! ! + +!BlockDeviceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testRead + | ba value | + ba := ByteArray new: 4. + value := -1. + self shouldnt: [ba longAt: 1 put: value bigEndian: true] raise: Error. + self assert: (ba longAt: 1 bigEndian: true) = value. + self shouldnt: [ba longAt: 1 put: value bigEndian: false] raise: Error. + self assert: (ba longAt: 1 bigEndian: false) = value. +! ! + +!BlockDeviceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testWriteChangesSector + | device newBytes originalBytes | + "(self confirm: 'This test is going to permanently write into secondary master partition, are you sure you want to continue?') + ifFalse: [^self]." + device := ATAController secondary master. + originalBytes := device at: 100. + newBytes := ByteArray new: 512. + + self fill: newBytes. + + [ + device at: 100 writeArray: newBytes. + self assert: (device at: 100) = newBytes asString + ] ensure: [ "Try to restore the original contents" + device at: 100 writeArray: originalBytes + ] +! ! + +!BlockDeviceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testWriteManySectors + | device newBytes originalBytes | + "(self confirm: 'This test is going to permanently write into secondary master partition, are you sure you want to continue?') + ifFalse: [^self]." + " + device := ATAController secondary master. + originalBytes := device at: 100. + newBytes := ByteArray new: 512. + + self fill: newBytes. + + [ + device replaceFromByte: 1030 bytesCount: 1500 with: newBytes startingAtByte: 20. + + self assert: (device at: 100) = newBytes asString + ] ensure: [ ""Try to restore the original contents"" + device at: 100 writeArray: originalBytes + ]" +! ! + +!BlockDeviceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testWriteSector + | device newBytes originalBytes | + "(self confirm: 'This test is going to permanently write into secondary master partition, are you sure you want to continue?') + ifFalse: [^self]." + device := ATAController secondary master. + originalBytes := device at: 100. + newBytes := ByteArray new: 512. + + self fill: newBytes. + + [ + device at: 100 writeArray: newBytes. + self assert: (device at: 100) = newBytes asString + ] ensure: [ "Try to restore the original contents" + device at: 100 writeArray: originalBytes + ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockDeviceTest class' category: #'SqueakNOS-Devices-Storage'! +BlockDeviceTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Devices/Storage/BlockDevicesTest.Class.st b/modules/NOS/Devices/Storage/BlockDevicesTest.Class.st new file mode 100644 index 00000000..2e1d02dd --- /dev/null +++ b/modules/NOS/Devices/Storage/BlockDevicesTest.Class.st @@ -0,0 +1,122 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #BlockDevicesTest category: 'SqueakNOS-Devices-Storage'! +TestCase subclass: #BlockDevicesTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!BlockDevicesTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +fill: aByteArray + 1 to: 512 do: [ :i | aByteArray at: i put: i \\ 256 ]. +! ! + +!BlockDevicesTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +test005Creation + self shouldnt: [ATAController primary master] raise: Error. + self shouldnt: [ATAController secondary slave] raise: Error. + +! ! + +!BlockDevicesTest methodsFor: 'objects' stamp: 'KenD 28/Jun/2026 13:32:24'! +testDevice + "Should warn that this will read and WRITE secondary slave hard disk" + ^ ATAController secondary slave. +! ! + +!BlockDevicesTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testImageSaving + | image collection raw tester cache bytes strm1 strm2 sizeToTest | + image := StandardFileStream fileNamed: SmalltalkImage current imageName. + sizeToTest := 1000000. + bytes := (image next: sizeToTest) asByteArray. + collection := OrderedCollection new: sizeToTest. + strm1 := ReadWriteStream on: collection. + strm2 := ReadWriteStream on: collection copy. + cache := BlockDeviceOnStream on: strm1 blockSize: 512. + cache enableCache. + raw := BlockDeviceOnStream on: strm2 blockSize: 512. + tester := DualTestBlockDevice deviceA: cache deviceB: raw. + tester at: 1 writeArray: bytes; flush. + self assert: (tester fromByte: 1 bytesCount: bytes size) asByteArray = bytes. + image close + +! ! + +!BlockDevicesTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testRead + | ba value | + ba := ByteArray new: 4. + value := -1. + self shouldnt: [ba longAt: 1 put: value bigEndian: true] raise: Error. + self assert: (ba longAt: 1 bigEndian: true) = value. + self shouldnt: [ba longAt: 1 put: value bigEndian: false] raise: Error. + self assert: (ba longAt: 1 bigEndian: false) = value. +! ! + +!BlockDevicesTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testWriteChangesSector + | device newBytes originalBytes | + "(self confirm: 'This test is going to permanently write into secondary master partition, are you sure you want to continue?') + ifFalse: [^self]." + device := ATAController secondary master. + originalBytes := device at: 100. + newBytes := ByteArray new: 512. + + self fill: newBytes. + + [ + device at: 100 writeArray: newBytes. + self assert: (device at: 100) = newBytes asString + ] ensure: [ "Try to restore the original contents" + device at: 100 writeArray: originalBytes + ] +! ! + +!BlockDevicesTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testWriteManySectors + | device newBytes originalBytes | + "(self confirm: 'This test is going to permanently write into secondary master partition, are you sure you want to continue?') + ifFalse: [^self]." + " + device := ATAController secondary master. + originalBytes := device at: 100. + newBytes := ByteArray new: 512. + + self fill: newBytes. + + [ + device replaceFromByte: 1030 bytesCount: 1500 with: newBytes startingAtByte: 20. + + self assert: (device at: 100) = newBytes asString + ] ensure: [ ""Try to restore the original contents"" + device at: 100 writeArray: originalBytes + ]" +! ! + +!BlockDevicesTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testWriteSector + | device newBytes originalBytes | + "(self confirm: 'This test is going to permanently write into secondary master partition, are you sure you want to continue?') + ifFalse: [^self]." + device := ATAController secondary master. + originalBytes := device at: 100. + newBytes := ByteArray new: 512. + + self fill: newBytes. + + [ + device at: 100 writeArray: newBytes. + self assert: (device at: 100) = newBytes asString + ] ensure: [ "Try to restore the original contents" + device at: 100 writeArray: originalBytes + ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockDevicesTest class' category: 'SqueakNOS-Devices-Storage'! +BlockDevicesTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Devices/Storage/IDEHardDiskDeviceInformation.Class.st b/modules/NOS/Devices/Storage/IDEHardDiskDeviceInformation.Class.st new file mode 100644 index 00000000..f2afb826 --- /dev/null +++ b/modules/NOS/Devices/Storage/IDEHardDiskDeviceInformation.Class.st @@ -0,0 +1,305 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #IDEHardDiskDeviceInformation category: 'SqueakNOS-Devices-Storage'! +ExternalStructure subclass: #IDEHardDiskDeviceInformation + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +capabilities + "This method was automatically generated" + ^handle signedLongAt: 99 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +capabilities: anObject + "This method was automatically generated" + handle signedLongAt: 99 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +configuration + "This method was automatically generated" + ^handle signedShortAt: 1 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +configuration: anObject + "This method was automatically generated" + handle signedShortAt: 1 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +cylindersCurrent + "This method was automatically generated" + ^handle signedShortAt: 109 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +cylindersCurrent: anObject + "This method was automatically generated" + handle signedShortAt: 109 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +cylindersDefault + "This method was automatically generated" + ^handle signedShortAt: 3 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +cylindersDefault: anObject + "This method was automatically generated" + handle signedShortAt: 3 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +headsCurrent + "This method was automatically generated" + ^handle signedShortAt: 111 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +headsCurrent: anObject + "This method was automatically generated" + handle signedShortAt: 111 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +headsDefault + "This method was automatically generated" + ^handle signedShortAt: 7 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +headsDefault: anObject + "This method was automatically generated" + handle signedShortAt: 7 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +minMultiwordDMAtime + "This method was automatically generated" + ^handle signedShortAt: 131 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +minMultiwordDMAtime: anObject + "This method was automatically generated" + handle signedShortAt: 131 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +model + ^self stringAt: 55 length: 40 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +multiwordDMAtransfer + "This method was automatically generated" + ^handle signedShortAt: 127 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +multiwordDMAtransfer: anObject + "This method was automatically generated" + handle signedShortAt: 127 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pioMode + "This method was automatically generated" + ^handle signedShortAt: 129 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pioMode: anObject + "This method was automatically generated" + handle signedShortAt: 129 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + aStream << self model; cr; + << 'sectors: '; << self sectors; cr; + <<'capabilities: '; << self capabilities hex ; cr; + << 'configuration: '; << self configuration hex; cr; + << 'version: '; << self version; cr; + << 'serial: '; << self serial; cr; + << 'pioMode: '; << self pioMode; cr; + << 'multiwordDMAtransfer: '; << self multiwordDMAtransfer +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectors + "This method was automatically generated" + ^handle signedLongAt: 121 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectors: anObject + "This method was automatically generated" + handle signedLongAt: 121 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorsCurrent + "This method was automatically generated" + ^handle signedShortAt: 113 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorsCurrent: anObject + "This method was automatically generated" + handle signedShortAt: 113 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorsDefault + "This method was automatically generated" + ^handle signedShortAt: 13 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorsDefault: anObject + "This method was automatically generated" + handle signedShortAt: 13 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorsExtended + "writtenByHand" + + | lo hi | + lo := handle unsignedLongAt: 201. + hi := handle unsignedShortAt: 205. + ^lo + (hi bitShift: 32) +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorsMultiple + "This method was automatically generated" + ^handle signedShortAt: 119 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorsMultiple: anObject + "This method was automatically generated" + handle signedShortAt: 119 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorsMultipleMax + "This method was automatically generated" + ^handle signedShortAt: 95 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +sectorsMultipleMax: anObject + "This method was automatically generated" + handle signedShortAt: 95 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +serial + ^self stringAt: 21 length: 10 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +specific + "This method was automatically generated" + ^handle signedShortAt: 5 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +specific: anObject + "This method was automatically generated" + handle signedShortAt: 5 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +stringAt: byteOffset length: length + "Return a structure of the given length starting at the indicated byte offset." + | value | + value := String new: length. + 1 to: length do:[:i| + value + at: i + (i odd ifTrue: [1] ifFalse: [-1]) + put: (handle unsignedCharAt: byteOffset+i-1)]. + ^value +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +totalSectorsCurrent + "This method was automatically generated" + ^handle signedLongAt: 115 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +totalSectorsCurrent: anObject + "This method was automatically generated" + handle signedLongAt: 115 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +validity + "This method was automatically generated" + ^handle signedShortAt: 107 +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +validity: anObject + "This method was automatically generated" + handle signedShortAt: 107 put: anObject +! ! + +!IDEHardDiskDeviceInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +version + ^self stringAt: 47 length: 8 + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IDEHardDiskDeviceInformation class' category: 'SqueakNOS-Devices-Storage'! +IDEHardDiskDeviceInformation class + instanceVariableNames: ''! + +!IDEHardDiskDeviceInformation class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +fields + "self defineFields" + ^#( + (configuration 'short') " 0 " + (cylindersDefault 'short') + (specific 'short') + (headsDefault 'short') + (nil 'long') " 4-5 " + (sectorsDefault 'short') " 6 " + (nil 'long') " 7-8 " + (nil 'short') " 9 " + (serial 'string' 20) " 10-19 " + (nil 'long') " 20-21 " + (nil 'short') + (version 'string' 8) " 23-26 " + (model 'string' 40) " 27-46 " + (sectorsMultipleMax 'short') " 47 " + (nil 'short') + (capabilities 'long') + (nil 'long') + (validity 'short') " 53 " + (cylindersCurrent 'short') + (headsCurrent 'short') + (sectorsCurrent 'short') + (totalSectorsCurrent 'long') + (sectorsMultiple 'short') + (sectors 'long') " 60-61 " + (nil 'short') + (multiwordDMAtransfer 'short') + (pioMode 'short') + (minMultiwordDMAtime 'short') + + ) +! ! + + diff --git a/modules/NOS/Devices/Storage/PCIBusMaster.Class.st b/modules/NOS/Devices/Storage/PCIBusMaster.Class.st new file mode 100644 index 00000000..0e9c3fef --- /dev/null +++ b/modules/NOS/Devices/Storage/PCIBusMaster.Class.st @@ -0,0 +1,135 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PCIBusMaster category: #'SqueakNOS-Devices-Storage'! +PCIDevice subclass: #PCIBusMaster + instanceVariableNames: 'channelOffset table function next offset' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearInterruptAndErrorBits + self status: (self status bitAnd: 2r11111001) +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +command + ^self byteAt: channelOffset + 0 +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +command: anInteger + self byteAt: channelOffset + 0 put: anInteger +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +entriesFor: size do: aBlock + | remaining chunkSize | + remaining := size. + [ remaining > 0 ] whileTrue: [ + chunkSize := remaining min: 65536. + aBlock value: chunkSize. + remaining := remaining - chunkSize] + + +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +function: aPCIEntry + function := aPCIEntry + +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + channelOffset := 0. + table := PhysicalRegionDescriptorTable new. + offset := 0. +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +issueRead + self + stopTransfer; + setDescriptorTablePointerRegister; + setDirectionToWriteIntoBus; + clearInterruptAndErrorBits; + startTransfer +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +offset +^offset +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetDescriptorTable + table reset +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +setDescriptorTablePointerRegister + self longAt: channelOffset + 4 put: table address +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +setDirectionToReadFromBus + self command: (self command bitAnd: 2r11110111) +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +setDirectionToWriteIntoBus + self command: (self command bitOr: 2r00001000) +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +setupTransferOf: size with: buffer + | position | + "buffer replaceFrom: 1 to: size with: 0." + position := buffer asInteger + offset. + self + entriesFor: size + do: [ :chunkSize | + table + atNextFreeEntryPutSize: chunkSize address: position; + advanceEntry. + position := position + chunkSize ]. + table markEndOfTransfer + "offset := offset + size" +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +startTransfer + self + command: (self command bitOr: 2r00000001) +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +status + ^self byteAt: channelOffset + 2 +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +status: anInteger + self byteAt: channelOffset + 2 put: anInteger +! ! + +!PCIBusMaster methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +stopTransfer + self command: (self command bitAnd: 16rFE) + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PCIBusMaster class' category: #'SqueakNOS-Devices-Storage'! +PCIBusMaster class + instanceVariableNames: ''! + +!PCIBusMaster class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +onPort: port function: pciEntry + ^ (self onPort: port) function: pciEntry +! ! + + +PCIBusMaster initialize! + diff --git a/modules/NOS/Devices/Storage/PhysicalRegionDescriptorTable.Class.st b/modules/NOS/Devices/Storage/PhysicalRegionDescriptorTable.Class.st new file mode 100644 index 00000000..4d903de8 --- /dev/null +++ b/modules/NOS/Devices/Storage/PhysicalRegionDescriptorTable.Class.st @@ -0,0 +1,79 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PhysicalRegionDescriptorTable category: #'SqueakNOS-Devices-Storage'! +Object subclass: #PhysicalRegionDescriptorTable + instanceVariableNames: 'address nextEntry' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Storage'! +!PhysicalRegionDescriptorTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +address + ^address asInteger + +! ! + +!PhysicalRegionDescriptorTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +advanceEntry + nextEntry := nextEntry = self size ifTrue: [ 1 ] ifFalse: [ nextEntry + 1 ]. + +! ! + +!PhysicalRegionDescriptorTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +atNextFreeEntryPutSize: size address: target + | offset encoded | + offset := self offsetOfEntry: nextEntry. + encoded := size = 65536 ifTrue: [ 0 ] ifFalse: [ size ]. + address unsignedLongAt: 1 + offset put: target; unsignedLongAt: 1 + offset + 4 put: encoded. +! ! + +!PhysicalRegionDescriptorTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +beEndOfTransferAt: entry + | offset | + offset := self offsetOfEntry: entry. + address byteAt: 1 + offset + 7 put: 16r80. +! ! + +!PhysicalRegionDescriptorTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + | size aligned | + nextEntry := 1. + size := 64 * 1024. + address := ExternalAddress allocate: size * 2 - 1. + aligned := address asInteger alignedTo: size. + address fromInteger: aligned. + "1 to: size do: [:i | address byteAt: i put: 0 ]" +! ! + +!PhysicalRegionDescriptorTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +markEndOfTransfer + | entry | + entry := nextEntry = 1 ifTrue: [ self size ] ifFalse: [ nextEntry - 1 ]. + self beEndOfTransferAt: entry +! ! + +!PhysicalRegionDescriptorTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +offsetOfEntry: entry + ^entry - 1 * 8 +! ! + +!PhysicalRegionDescriptorTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +reset + nextEntry := 1. + +! ! + +!PhysicalRegionDescriptorTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +size + ^64 * 1024 // 8 + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PhysicalRegionDescriptorTable class' category: #'SqueakNOS-Devices-Storage'! +PhysicalRegionDescriptorTable class + instanceVariableNames: ''! + + +PhysicalRegionDescriptorTable initialize! + diff --git a/modules/NOS/Devices/USB/SDDevice.Class.st b/modules/NOS/Devices/USB/SDDevice.Class.st new file mode 100644 index 00000000..8cacd8e0 --- /dev/null +++ b/modules/NOS/Devices/USB/SDDevice.Class.st @@ -0,0 +1,483 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #SDDevice category: 'SqueakNOS-Devices-USB'! +PCIDevice subclass: #SDDevice + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-USB'! +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +blockSizeRegister + ^self shortAt: 16r04 +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +canIssueCommand + ^(self testPresentStateBit: 0) not +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +canIssueDATCommand + ^(self testPresentStateBit: 1) not +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +canWriteData + ^self testPresentStateBit: 10 +! ! + +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +capabilitiesRegister + ^self longAt: 16r40 +! ! + +!SDDevice methodsFor: 'low level' stamp: 'KenD 28/Jun/2026 13:32:24'! +cardDetectPinLevel + ^(self testPresentStateBit: 18) ifTrue: [1] ifFalse: [0] +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +checkCardPresent + self isCardInserted + ifTrue: [self report: 'card inserted'] + ifFalse: [self report: 'card removed']. +! ! + +!SDDevice methodsFor: 'clearing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearCardInsertionInterrupt + self setInterruptStatusBit:6 +! ! + +!SDDevice methodsFor: 'clearing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearCardRemovalInterrupt + self setInterruptStatusBit: 7 +! ! + +!SDDevice methodsFor: 'clearing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearCommandCompleteInterrupt + self setInterruptStatusBit: 0 +! ! + +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +clockControlRegister + ^ self shortAt: 16r2C +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableBlockGapInterrupt + self setInterruptEnableBit: 2 +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableBufferReadyInterrupt + self setInterruptEnableBit: 5 +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableBufferWriteReadyInterrupt + self setInterruptEnableBit: 4 +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCardInsertionInterrupt + self setInterruptEnableBit: 6; enableCardInsertionInterruptStatus +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCardInsertionInterruptStatus + self setInterruptStatusEnableBit: 6 +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCardInterrupt + self setInterruptEnableBit: 8; enableCardInterruptStatus +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCardInterruptStatus + self setInterruptStatusEnableBit: 8 +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCardRemovalInterrupt + self setInterruptEnableBit: 7; enableCardRemovalInterruptStatus +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCardRemovalInterruptStatus + self setInterruptStatusEnableBit: 7 +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCommandCompleteInterrupt + self setInterruptEnableBit: 0; enableCommandCompleteInterruptStatus +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableCommandCompleteInterruptStatus + self setInterruptStatusEnableBit: 0 +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableDMAInterrupt + self setInterruptEnableBit: 3 +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableErrorInterrupt + self setErrorInterruptEnableBit: 0; + setErrorInterruptEnableBit: 1; + setErrorInterruptEnableBit: 2; + setErrorInterruptEnableBit: 3; + setErrorInterruptEnableBit: 4; + setErrorInterruptEnableBit: 5; + setErrorInterruptStatusEnableBit: 1; + setErrorInterruptStatusEnableBit: 2; + setErrorInterruptStatusEnableBit: 3; + setErrorInterruptStatusEnableBit: 4; + setErrorInterruptStatusEnableBit: 5 +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableInterrupts + self enableCardRemovalInterrupt; + enableCardInsertionInterrupt; + enableCommandCompleteInterrupt; + enableErrorInterrupt +! ! + +!SDDevice methodsFor: 'enabling interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableTransferCompleteInterrupt + self setInterruptEnableBit: 1 +! ! + +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +errorInterruptEnableRegister + ^self shortAt: 16r3A +! ! + +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +errorInterruptStatus + ^self shortAt: 16r32 +! ! + +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +errorInterruptStatusEnableRegister + ^self shortAt: 16r36 +! ! + +!SDDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +getCardID + | answer address arg | + address := self getRelativeAddress. + arg := address bitShift: 16. + answer := self sendCommand: 10 with: arg. + ^answer bitAnd: 16rFFFF + +SDCommands +! ! + +!SDDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +getRelativeAddress + | answer | + answer := self sendCommand: 3. + answer bitShift: -16. + ^answer bitAnd: 16rFFFF +! ! + +!SDDevice methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleIRQ + self hasCardRemovalInterrupt ifTrue: [ + self clearCardRemovalInterrupt. + self checkCardPresent]. + self hasCardInsertionInterrupt ifTrue: [ + self clearCardInsertionInterrupt. + self checkCardPresent]. + self hasCommandCompleteInterrupt ifTrue: [ + self clearCommandCompleteInterrupt]. +! ! + +!SDDevice methodsFor: 'testing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasBlockGapInterrupt + ^self testInterruptStatusBit: 2 +! ! + +!SDDevice methodsFor: 'testing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasBufferReadReadyInterrupt + ^self testInterruptStatusBit: 5 +! ! + +!SDDevice methodsFor: 'testing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasBufferWriteReadyInterrupt + ^self testInterruptStatusBit: 4 +! ! + +!SDDevice methodsFor: 'testing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasCardInsertionInterrupt + ^self testInterruptStatusBit: 6 +! ! + +!SDDevice methodsFor: 'testing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasCardRemovalInterrupt + ^self testInterruptStatusBit: 7 +! ! + +!SDDevice methodsFor: 'testing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasCommandCompleteInterrupt + ^self testInterruptStatusBit: 0 +! ! + +!SDDevice methodsFor: 'testing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasDMAInterrupt + ^self testInterruptStatusBit: 3 +! ! + +!SDDevice methodsFor: 'testing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasErrorInterrupt + ^self testInterruptStatusBit: 15 +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasReadableData + ^self testPresentStateBit: 11 +! ! + +!SDDevice methodsFor: 'testing interrupts' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasTransferCompleteInterrupt + ^self testInterruptStatusBit: 1 +! ! + +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptEnableRegister + ^self shortAt: 16r38 +! ! + +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptStatus + ^self shortAt: 16r30 +! ! + +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptStatusEnableRegister + ^self shortAt: 16r34 +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isCardInserted + ^self testPresentStateBit: 16 +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isCardPresent + ^self testPresentStateBit: 18 +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isDATLineActive + ^self testPresentStateBit: 2 +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isReadingData + ^self testPresentStateBit: 9 +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isStateStable + ^self testPresentStateBit: 17 +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isWriteProtected + ^(self testPresentStateBit: 19) not +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isWritingData + ^self testPresentStateBit: 8 +! ! + +!SDDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +lineSignalLevel + ^self testPresentStateBit: 24 +! ! + +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +presentState + ^self longAt: 16r24 +! ! + +!SDDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +readResponse + | answer | + answer := self responseRegister +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +reportStatus +! ! + +!SDDevice methodsFor: 'registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +responseRegister + ^self longAt: 16r10 +! ! + +!SDDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +sendCommand: c + self sendCommand: c with: 0 +! ! + +!SDDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +sendCommand: c with: arg + self + waitForCommandSendAllowed; + waitForDATCommandAllowed; + longAt: 16r08 put: arg; + shortAt: 16r0E put: (c bitShift: 8); + waitForCommandComplete; + readResponse +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +setClockControlRegisterBit: bit + | register | + register := self clockControlRegister. + register := register bitOr: (1 bitShift: bit). + self shortAt: 16r2C put: register +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +setErrorInterruptEnableBit: bit + | register | + register := self errorInterruptEnableRegister. + register := register bitOr: (1 bitShift: bit). + self longAt: 16r3A put: register +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +setErrorInterruptStatusEnableBit: bit + | register | + register := self errorInterruptStatusEnableRegister. + register := register bitOr: (1 bitShift: bit). + self longAt: 16r36 put: register +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +setInterruptEnableBit: bit + | register | + register := self interruptEnableRegister. + register := register bitOr: (1 bitShift: bit). + self longAt: 16r38 put: register +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +setInterruptStatusBit: bit + | register | + register := self interruptStatus. + register := register bitOr: (1 bitShift: bit). + self longAt: 16r30 put: register +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +setInterruptStatusEnableBit: bit + | register | + register := self interruptStatusEnableRegister. + register := register bitOr: (1 bitShift: bit). + self longAt: 16r34 put: register +! ! + +!SDDevice methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +supportsHighSpeed + ^self testCapabilitiesBit: 21 +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +testCapabilitiesBit: bit + ^self capacilitiesRegister anyMask: (1 bitShift: bit) +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +testErrorInterruptStatusBit: bit + ^self errorInterruptStatus anyMask: (1 bitShift: bit) +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +testInterruptStatusBit: bit + ^self interruptStatus anyMask: (1 bitShift: bit) +! ! + +!SDDevice methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +testPresentStateBit: bit + ^self presentState anyMask: (1 bitShift: bit) +! ! + +!SDDevice methodsFor: 'serivices' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitFor: aBlock + aBlock whileFalse +! ! + +!SDDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitForCommandComplete + self waitFor: [self hasCommandCompleteInterrupt] +! ! + +!SDDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitForCommandSendAllowed + self waitFor: [self canIssueCommand] +! ! + +!SDDevice methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:32:24'! +waitForDATCommandAllowed + self waitFor: [self canIssueDATCommand] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SDDevice class' category: 'SqueakNOS-Devices-USB'! +SDDevice class + instanceVariableNames: ''! + +!SDDevice class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +deviceId + ^2082 +! ! + +!SDDevice class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + self initializeSDCommands +! ! + +!SDDevice class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeSDCommands + SDCommands := Dictionary new + at: 'SendCSD' put: 8; + at: 'SendCID' put: 10; + at: 'SendRelativeAddress' put: 3; + yourself +! ! + +!SDDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + | card | + card := super installOn: aComputer. + card ifNil: [^ nil]. + card enableInterrupts. + aComputer sdCard: card. + ^card +! ! + +!SDDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +onPCIEntry: aPCIBusEntry + ^self atMemoryAddress: aPCIBusEntry allMemoryRanges first key. + +! ! + +!SDDevice class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +vendorId + ^4480 +! ! + + +SDDevice initialize! + diff --git a/modules/NOS/Devices/USB/USBQueueHead.Class.st b/modules/NOS/Devices/USB/USBQueueHead.Class.st new file mode 100644 index 00000000..22b0ee1e --- /dev/null +++ b/modules/NOS/Devices/USB/USBQueueHead.Class.st @@ -0,0 +1,125 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #USBQueueHead category: 'SqueakNOS-Devices-USB'! +ExternalStructure subclass: #USBQueueHead + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-USB'! +!USBQueueHead methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +beEmpty + ^ self queueElementLinkPointerRQT: 1 +! ! + +!USBQueueHead methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +beTerminator + self queueHeadLinkPointerQT: 1 +! ! + +!USBQueueHead methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +first + self isEmpty ifTrue: [^ nil]. + self firstIsQueueHead + ifTrue: [^ USBQueueHead fromHandle: self firstAddress] + ifFalse: [^ USBTransferDescriptor fromHandle: self firstAddress] +! ! + +!USBQueueHead methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +first: usbQHorTD + | address | + address := usbQHorTD address asInteger. + (address anyMask: 2r1111) ifTrue: [self error: 'QH element must be aligned to 16']. + usbQHorTD isQueueHead ifTrue: [address := address bitOr: 2r10]. " turn on Q bit. " + self queueElementLinkPointerRQT: address. " clear Terminator " +! ! + +!USBQueueHead methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +firstAddress + ^ ExternalAddress new fromInteger: (self queueElementLinkPointerRQT bitClear: 2r1111) +! ! + +!USBQueueHead methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +firstIsQueueHead + ^ self queueElementLinkPointerRQT anyMask: 2r10 +! ! + +!USBQueueHead methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +firstIsTransferDescriptor + ^ self firstIsQueueHead not +! ! + +!USBQueueHead methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isEmpty + ^ self queueElementLinkPointerRQT anyMask: 1 +! ! + +!USBQueueHead methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isQueueHead + ^ true +! ! + +!USBQueueHead methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +isTerminator + self queueHeadLinkPointerQT anyMask: 1 +! ! + +!USBQueueHead methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isTransferDescriptor + ^ false +! ! + +!USBQueueHead methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +next: usbQHorTD + | address | + address := usbQHorTD address asInteger. + (address anyMask: 2r1111) ifTrue: [self error: 'QH element must be aligned to 16']. + usbQHorTD isQueueHead ifTrue: [address := address bitOr: 2r10]. " turn on Q bit. " + self queueHeadLinkPointerQT: address. " clear Terminator " +! ! + +!USBQueueHead methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +queueElementLinkPointerRQT + "This method was automatically generated" + ^handle unsignedLongAt: 5 +! ! + +!USBQueueHead methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +queueElementLinkPointerRQT: anObject + "This method was automatically generated" + handle unsignedLongAt: 5 put: anObject +! ! + +!USBQueueHead methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +queueHeadLinkPointerQT + "This method was automatically generated" + ^handle unsignedLongAt: 1 +! ! + +!USBQueueHead methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +queueHeadLinkPointerQT: anObject + "This method was automatically generated" + handle unsignedLongAt: 1 put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'USBQueueHead class' category: 'SqueakNOS-Devices-USB'! +USBQueueHead class + instanceVariableNames: ''! + +!USBQueueHead class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +externalNew + "must be aligned to 16" + ^self externalNewAligned: 16 +! ! + +!USBQueueHead class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +fields + "self defineFields" + ^#( + (queueHeadLinkPointerQT 'ulong') + (queueElementLinkPointerRQT 'ulong') + ) +! ! + + diff --git a/modules/NOS/Devices/USB/USBTransferDescriptor.Class.st b/modules/NOS/Devices/USB/USBTransferDescriptor.Class.st new file mode 100644 index 00000000..77055c5a --- /dev/null +++ b/modules/NOS/Devices/USB/USBTransferDescriptor.Class.st @@ -0,0 +1,318 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #USBTransferDescriptor category: 'SqueakNOS-Devices-USB'! +ExternalStructure subclass: #USBTransferDescriptor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-USB'! +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +activate + self statusActLen: (self statusActLen bitOr: 1 << 23) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +actualLength + ^ (self statusActLen bitAnd: 16r3FF) + 1 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +actualLength: anInteger + ^ self statusActLen: (self statusActLen bitAnd: 16rFFFFFC00) + (anInteger - 1) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +beData0 + self maxLenAddr: (self maxLenAddr bitClear: 1 << 19) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +beData1 + self maxLenAddr: (self maxLenAddr bitOr: 1 << 19) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +beFullSpeedDevice + self statusActLen: (self statusActLen bitClear: 1 << 26) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +beInput + self packetIdentification: 16r69 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +beIsochronous + self statusActLen: (self statusActLen bitOr: 1 << 25) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +beLowSpeedDevice + self statusActLen: (self statusActLen bitOr: 1 << 26) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +beNonIsochronous + self statusActLen: (self statusActLen bitClear: 1 << 25) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +beOutput + self packetIdentification: 16rE1 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +beSetup + self packetIdentification: 16r2D +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +beTerminator + self linkPointerVQT: (self linkPointerVQT bitOr: 1) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +bufferPointer + "This method was automatically generated" + ^handle unsignedLongAt: 13 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +bufferPointer: anObject + "This method was automatically generated" + handle unsignedLongAt: 13 put: anObject +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearLinkPointer + self linkPointerVQT: 1 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +deviceAddress + ^ self maxLenAddr >> 8 bitAnd: 16r7F +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +deviceAddress: anInteger + self maxLenAddr: anInteger << 8 + (self maxLenAddr bitAnd: 16rFFFF80FF) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableInterruptOnComplete + self statusActLen: (self statusActLen bitAnd: (1 << 24) bitInvert) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableShortPacketDetect + self statusActLen: (self statusActLen bitClear: 1 << 29) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableInterruptOnComplete + self statusActLen: (self statusActLen bitOr: 1 << 24) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableShortPacketDetect + self statusActLen: (self statusActLen bitOr: 1 << 29) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +endpoint + ^ self maxLenAddr >> 15 bitAnd: 16rF +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +endpoint: anInteger + self maxLenAddr: anInteger << 15 + (self maxLenAddr bitAnd: 16rFFC07FFF) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +errorCount + ^ self statusActLen >> 27 bitAnd: 3 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +errorCount: anInteger + ^ self statusActLen: (self statusActLen bitAnd: (3 << 27) bitInvert) + (anInteger << 27) + +! ! + +!USBTransferDescriptor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + self + clearLinkPointer; + statusActLen: 0; + maxLenAddr: 0. +! ! + +!USBTransferDescriptor methodsFor: 'accessing - status etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +isActive + ^ self statusActLen anyMask: 1 << 23 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +isBreadthFirst + ^ self isDepthFirst not +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +isData0 + ^ self isData1 not +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +isData1 + ^ self maxLenAddr anyMask: 1 << 19 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +isDepthFirst + ^ self linkPointerVQT anyMask: 2r100 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +isQueueHead + ^ false +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +isTerminator + ^ self linkPointerVQT anyMask: 1 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +isTransferDescriptor + ^ true +! ! + +!USBTransferDescriptor methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +linkPointerVQT + "This method was automatically generated" + ^handle unsignedLongAt: 1 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +linkPointerVQT: anObject + "This method was automatically generated" + handle unsignedLongAt: 1 put: anObject +! ! + +!USBTransferDescriptor methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +maxLenAddr + "This method was automatically generated" + ^handle unsignedLongAt: 9 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +maxLenAddr: anObject + "This method was automatically generated" + handle unsignedLongAt: 9 put: anObject +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +maxLength + ^ self maxLenAddr >> 21 bitAnd: 16r7FF +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +maxLength: anInteger + anInteger > 1280 ifTrue: [self error: 'Maximum allowed length for USB transfers is 1280']. + self maxLenAddr: (self maxLenAddr bitAnd: 16r1FFFFF) + (anInteger - 1 << 21) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +next + self isTerminator ifTrue: [^ nil]. + self nextIsQueueHead + ifTrue: [^ USBQueueHead fromHandle: self nextAddress] + ifFalse: [^ USBTransferDescriptor fromHandle: self nextAddress] + +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +next: usbQHorTD + | address | + address := usbQHorTD address asInteger. + (address anyMask: 2r1111) ifTrue: [self error: 'Elements must be aligned to 16']. + usbQHorTD isQueueHead ifTrue: [address := address bitOr: 2r10]. " turn on Q bit. " + self isDepthFirst ifTrue: [address := address bitOr: 2r100]. " maintain Vf " + self linkPointerVQT: address. " clear Terminator " + +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextAddress + ^ ExternalAddress new fromInteger: (self linkPointerVQT bitClear: 2r1111). +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextBeQueueHead + self linkPointerVQT: (self linkPointerVQT bitOr: 2r10) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextBeTransferDescriptor + self linkPointerVQT: (self linkPointerVQT bitClear: 2r10) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextIsQueueHead + ^ self linkPointerVQT anyMask: 2r10 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - link pointer' stamp: 'KenD 28/Jun/2026 13:32:24'! +nextIsTransferDescriptor + ^ self nextIsQueueHead not +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +packetIdentification + ^ self maxLenAddr bitAnd: 16rFF +! ! + +!USBTransferDescriptor methodsFor: 'accessing - max len etc.' stamp: 'KenD 28/Jun/2026 13:32:24'! +packetIdentification: anInteger + self maxLenAddr: anInteger + (self maxLenAddr bitClear: 16rFF) +! ! + +!USBTransferDescriptor methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusActLen + "This method was automatically generated" + ^handle unsignedLongAt: 5 +! ! + +!USBTransferDescriptor methodsFor: 'accessing - automatic' stamp: 'KenD 28/Jun/2026 13:32:24'! +statusActLen: anObject + "This method was automatically generated" + handle unsignedLongAt: 5 put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'USBTransferDescriptor class' category: 'SqueakNOS-Devices-USB'! +USBTransferDescriptor class + instanceVariableNames: ''! + +!USBTransferDescriptor class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +externalNew + "must be aligned to 16" + ^self externalNewAligned: 16 +! ! + +!USBTransferDescriptor class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +fields + "self defineFields" + ^#( + (linkPointerVQT 'ulong') + (statusActLen 'ulong') + (maxLenAddr 'ulong') + (bufferPointer 'ulong') + ) +! ! + + +USBTransferDescriptor initialize! + diff --git a/modules/NOS/Devices/USB/USBUHCIController.Class.st b/modules/NOS/Devices/USB/USBUHCIController.Class.st new file mode 100644 index 00000000..a2dff118 --- /dev/null +++ b/modules/NOS/Devices/USB/USBUHCIController.Class.st @@ -0,0 +1,844 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #USBUHCIController category: 'SqueakNOS-Devices-USB'! +HardwareDevice subclass: #USBUHCIController + instanceVariableNames: 'frameList' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-USB'! +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +acknowledgeForceGlobalResume + ^self clearCommandBit: 4 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearCommandBit: bit + ^ self command: (self command bitClear: 1 << bit) +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearFrameListAt: index + self frameListValueAt: index put: 1 " 1 = termiator " +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearInterruptBit: bit + ^ self interruptEnable: (self interruptEnable bitClear: 1 << bit) + +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearPort1ConnectStatusChange + ^self setPort1ControlBit: 1 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearPort1ControlBit: bit + ^ self port1StatusControl: (self port1StatusControl bitClear: 1 << bit) +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearPort1EnableStatusChange + ^self setPort1ControlBit: 3 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearPort2ConnectStatusChange + ^self setPort2ControlBit: 1 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearPort2ControlBit: bit + ^ self port2StatusControl: (self port2StatusControl bitClear: 1 << bit) +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +clearPort2EnableStatusChange + ^self setPort2ControlBit: 3 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +command + ^self shortAt: 0 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +command: anInteger + ^self shortAt: 0 put: anInteger +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableAllInterrupts + self interruptEnable: 0 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableConfigureFlag + ^self clearCommandBit: 6 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableGlobalReset + ^self clearCommandBit: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableGlobalSuspendMode + ^self setCommandBit: 3 + +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableInterruptOnComplete + self clearInterruptBit: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +disablePort1 + ^self clearPort1ControlBit: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +disablePort1Reset + self clearPort1ControlBit: 9 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +disablePort1ResumeSignaling + self clearPort1ControlBit: 6 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +disablePort1Suspend + self clearPort1ControlBit: 12 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +disablePort2 + ^self clearPort2ControlBit: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +disablePort2Reset + self clearPort2ControlBit: 9 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +disablePort2ResumeSignaling + self clearPort2ControlBit: 6 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +disablePort2Suspend + self clearPort2ControlBit: 12 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableScheduling + ^self clearCommandBit: 0 +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableShortPacketInterrupt + self clearInterruptBit: 3 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableSoftwareDebug + ^self clearCommandBit: 5 +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +disableTimeoutCRCInterrupt + self clearInterruptBit: 0 +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableAllInterrupts + self interruptEnable: 2r1111 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableConfigureFlag + ^self setCommandBit: 6 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableGlobalReset + ^self setCommandBit: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableInterruptOnComplete + self setInterruptBit: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +enablePort1 + ^self setPort1ControlBit: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +enablePort1Reset + self setPort1ControlBit: 9 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +enablePort1ResumeSignaling + self setPort1ControlBit: 6 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +enablePort1Suspend + self setPort1ControlBit: 12 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +enablePort2 + ^self setPort2ControlBit: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +enablePort2Reset + self setPort2ControlBit: 9 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +enablePort2ResumeSignaling + self setPort2ControlBit: 6 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +enablePort2Suspend + self setPort2ControlBit: 12 +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableResumeInterrupt + self setInterruptBit: 1 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableScheduling + ^self setCommandBit: 0 +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableShortPacketInterrupt + self setInterruptBit: 3 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableSoftwareDebug + ^self setCommandBit: 5 +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +enableTimeoutCRCInterrupt + self setInterruptBit: 0 +! ! + +!USBUHCIController methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +errorInterruptPending + ^self testStatusBit: 1 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +forceGlobalResumeRequested + ^self testCommandBit: 4 +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameList + ^ frameList +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameListAddressAt: index + ^ ExternalAddress new fromInteger: ((self frameListValueAt: index) bitClear: 2r1111) +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameListAt: index + (self isTerminatorAt: index) ifTrue: [^nil]. + ^ (self isPointingToQueueHeadAt: index) + ifTrue: [USBQueueHead fromHandle: (self frameListAddressAt: index)] + ifFalse: [USBTransferDescriptor fromHandle: (self frameListAddressAt: index)] +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameListAt: index put: aListElement + aListElement ifNil: [^ self clearFrameListAt: index]. + self frameListValueAt: index put: aListElement address. " this clears the [next] terminator flag " + aListElement isQueueHead + ifTrue: [self pointToQueueHeadAt: index] + ifFalse: [self pointToTransferDescriptorAt: index] + +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameListBaseAddress + ^self longAt: 8 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameListBaseAddress: anInteger + ^self longAt: 8 put: anInteger +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameListValueAt: index + ^frameList unsignedLongAt: index * 4 - 3 +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameListValueAt: index put: anInteger + frameList unsignedLongAt: index * 4 - 3 put: anInteger +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameNumber + ^self shortAt: 6 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +frameNumber: anInteger + ^self shortAt: 6 put: anInteger +! ! + +!USBUHCIController methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleIRQ + self report: 'Command: ', self command hex, ' Status: ', self status hex. + self resetStatus. + +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasBeenConfigured + ^self testCommandBit: 6 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasSchedulingEnabled + ^self testCommandBit: 0 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hasSoftwareDebugEnabled + ^self testCommandBit: 5 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +hostControllerResetHasFinished + ^(self testCommandBit: 1) not +! ! + +!USBUHCIController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + | delay10ms | + delay10ms := Delay forMilliseconds: 10. + self enableGlobalReset. + delay10ms wait. + self + disableGlobalReset; + startHostControllerReset. + [self hostControllerResetHasFinished] whileFalse: [delay10ms wait]. + self + disableScheduling; + disableAllInterrupts; + disableConfigureFlag; + initializeFrameList; + maxPacketSize: 64; + enableAllInterrupts; + enableScheduling; + enableConfigureFlag. + self initializeRootHubs. +! ! + +!USBUHCIController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeFrameList + frameList := ExternalAddress allocate: 4*1024 aligned: 4*1024. + 1 to: 1024 do: [:i | self clearFrameListAt: i]. + self frameListBaseAddress: frameList asInteger. + self frameNumber: 0. +! ! + +!USBUHCIController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeRootHubs + " +\ We mustn't wait more than 3 ms between releasing the reset and enabling +\ the port to begin the SOF stream, otherwise some devices (e.g. pl2303) +\ will go into suspend state and then not respond to set-address. +: reset-root-hub-port ( port -- ) + dup >r portsc@ h# 20e invert and ( value r: port ) \ Clear reset, enable, status + dup h# 200 or r@ portsc!! ( value r: port ) \ Reset port + d# 30 ms ( value r: port ) \ > 10 ms - reset time + dup r@ portsc!! ( value r: port ) \ Release reset + 1 ms ( value r: port ) \ > 5.3 uS - reconnect time + h# e or r> portsc!! ( ) \ Enable port and clear status +; + +: probe-root-hub-port ( port -- ) + dup reset-root-hub-port + dup portsc@ 1 and 0= if drop exit then \ No device-connected + ok-to-add-device? 0= if drop exit then \ Can't add another device + + new-address ( port dev ) + over portsc@ 100 and if speed-low else speed-full then + over di-speed!! ( port dev ) + + 0 set-target ( port dev ) \ Address it as device 0 + dup set-address if 2drop exit then ( port dev ) \ Assign it usb addr dev + dup set-target ( port dev ) \ Address it as device dev + make-device-node ( ) +; + +external +: power-ports ( -- ) ; + +: probe-root-hub ( -- ) + \ Set active-package so device nodes can be added and removed + my-self ihandle>phandle push-package + + alloc-pkt-buf + 2 0 do + i portsc@ h# a and if + i rm-obsolete-children \ Remove obsolete device nodes + i ['] probe-root-hub-port catch if + drop .' Failed to probe root port ' i .d cr + then + i portsc@ i portsc!! \ Clear change bits + then + loop + free-pkt-buf + + pop-package +; + " +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptEnable + ^self shortAt: 4 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptEnable: anInteger + ^self shortAt: 4 put: anInteger +! ! + +!USBUHCIController methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +interruptPending + ^self testStatusBit: 0 +! ! + +!USBUHCIController methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +isHalted + ^self testStatusBit: 5 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +isInGlobalSuspendMode + ^self testCommandBit: 3 +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +isPointingToQueueHeadAt: index + ^ (self frameListValueAt: index) anyMask: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +isPointingToTransferDescriptorAt: index + ^ ((self frameListValueAt: index) anyMask: 2) not +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +isTerminatorAt: index + ^ (self frameListValueAt: index) anyMask: 1 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +maxPacketSize + ^(self testCommandBit: 7) + ifTrue: [64] + ifFalse: [32] +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +maxPacketSize: anInteger + anInteger == 32 ifTrue: [^self clearCommandBit: 7]. + anInteger == 64 ifTrue: [^self setCommandBit: 7]. + self error: 'Invalid maxPacketSize. Only 32 or 64 bytes allowed' +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +pointToQueueHeadAt: index + ^ self + frameListValueAt: index + put: ((self frameListValueAt: index) bitOr: 2) +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +pointToQueueHeaderAt: index + ^ self + frameListValueAt: index + put: ((self frameListValueAt: index) bitOr: 2) +! ! + +!USBUHCIController methodsFor: 'accessing - frame list' stamp: 'KenD 28/Jun/2026 13:32:24'! +pointToTransferDescriptorAt: index + ^ self + frameListValueAt: index + put: ((self frameListValueAt: index) bitAnd: 2 bitInvert) +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port1ConnectStatusHasChanged + ^self testPort1StatusBit: 1 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port1EnableStatusHasChanged + ^self testPort1StatusBit: 3 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port1HasDeviceConnected + ^self testPort1StatusBit: 0 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port1HasLowSpeedDeviceAttached + ^self testPort1StatusBit: 8 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port1IsReset + ^self testPort1StatusBit: 9 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port1IsSuspended + ^self testPort1StatusBit: 12 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port1LineStatus + ^(self testPort1StatusBit: 5) * 2 + (self testPort1StatusBit: 4) +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +port1StatusControl + ^self shortAt: 16 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +port1StatusControl: anInteger + ^self shortAt: 16 put: anInteger +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port2ConnectStatusHasChanged + ^self testPort2StatusBit: 1 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port2EnableStatusHasChanged + ^self testPort2StatusBit: 3 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port2HasDeviceConnected + ^self testPort2StatusBit: 0 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port2HasLowSpeedDeviceAttached + ^self testPort2StatusBit: 8 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port2IsReset + ^self testPort2StatusBit: 9 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port2IsSuspended + ^self testPort2StatusBit: 12 +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +port2LineStatus + ^(self testPort2StatusBit: 5) * 2 + (self testPort2StatusBit: 4) +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +port2StatusControl + ^self shortAt: 18 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +port2StatusControl: anInteger + ^self shortAt: 18 put: anInteger +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +power1StatusControl + ^self shortAt: 16 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +power1StatusControl: anInteger + ^self shortAt: 16 put: anInteger +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +power2StatusControl + ^self shortAt: 18 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +power2StatusControl: anInteger + ^self shortAt: 18 put: anInteger +! ! + +!USBUHCIController methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +processError + ^self testStatusBit: 4 +! ! + +!USBUHCIController methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +resetStatus + " Writing a 1 clears that bit status " + ^self status: self status +! ! + +!USBUHCIController methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +resumeRequestedByDevice + ^self testStatusBit: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +setCommandBit: bit + ^ self command: (self command bitOr: 1 << bit) + +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +setInterruptBit: bit + ^ self interruptEnable: (self interruptEnable bitOr: 1 << bit) + +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +setPort1ControlBit: bit + ^ self port1StatusControl: (self port1StatusControl bitOr: 1 << bit) + +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +setPort2ControlBit: bit + ^ self port2StatusControl: (self port2StatusControl bitOr: 1 << bit) + +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +startHostControllerReset + ^self setCommandBit: 1 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +startOfFrameModify + ^self byteAt: 12 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +startOfFrameModify: anInteger + ^self byteAt: 12 put: anInteger +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +status + ^self shortAt: 2 +! ! + +!USBUHCIController methodsFor: 'accessing - registers' stamp: 'KenD 28/Jun/2026 13:32:24'! +status: anInteger + ^self shortAt: 2 put: anInteger +! ! + +!USBUHCIController methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +systemError + ^self testStatusBit: 3 +! ! + +!USBUHCIController methodsFor: 'accessing - command register' stamp: 'KenD 28/Jun/2026 13:32:24'! +testCommandBit: bit + ^ self command anyMask: 1 << bit +! ! + +!USBUHCIController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +testGetDeviceDescriptor + | qh tdSetup tdData tdStatus buf | + self enablePort1Reset. + (Delay forMilliseconds: 10) wait. + self disablePort1Reset. + self enablePort1. + self clearPort1ConnectStatusChange; clearPort1EnableStatusChange. + + qh := USBQueueHead externalNew. + tdSetup := USBTransferDescriptor externalNew. + tdData := USBTransferDescriptor externalNew. + tdStatus := USBTransferDescriptor externalNew. + buf := ExternalAddress allocate: 2000. + + qh beTerminator; beEmpty; next: qh. + + 1 to: 1024 do: [:i | self frameListAt: i put: qh]. + + tdSetup next: tdData. + tdData next: tdStatus. + + tdSetup beData0; beSetup; activate; errorCount: 3; bufferPointer: buf asInteger; enableInterruptOnComplete. + tdData beData1; beInput; activate; errorCount: 3; bufferPointer: buf asInteger; enableInterruptOnComplete. + tdStatus beData1; beOutput; activate; errorCount: 3; beTerminator; enableInterruptOnComplete. + + tdSetup maxLength: 8. + tdData maxLength: 1000. + + buf + byteAt: 1 put: 16r80; " Input. Standard. Device " + byteAt: 2 put: 6; " GET_DESCRIPTOR " + unsignedByteAt: 3 put: 0; " wValue: idx" + unsignedByteAt: 4 put: 1; " wValue: DEVICE" + unsignedShortAt: 5 put: 0; + unsignedShortAt: 7 put: 18. + + qh first: tdSetup. + + ^ Array with: qh with: buf. +! ! + +!USBUHCIController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +testGetStringDescriptor: idx + | td buf | + td := USBTransferDescriptor externalNew. + buf := ExternalAddress allocate: 1280. + td bufferPointer: buf asInteger. + td packetIdentification: 16r2D. + td maxLength: 1280. + td errorCount: 3. + td activate. + buf + byteAt: 1 put: 16r80; " bmRequestType: Direction=Device to Host | Type=Standard | Recipient=Device " + byteAt: 2 put: 6; " bRequest: GET_DESCRIPTOR " + unsignedByteAt: 3 put: idx; " wValue: idx" + unsignedByteAt: 4 put: 3; " wValue: STRING" + unsignedShortAt: 5 put: 0; " wIndex: LANGUAGE" + unsignedShortAt: 7 put: 1000." wLength: 1000 " + self frameListAt: 90 put: td. + ^ Array with: td with: buf. + +! ! + +!USBUHCIController methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +testInput + | td buf | + td := USBTransferDescriptor externalNew. + buf := ExternalAddress allocate: 1500. + td bufferPointer: buf asInteger. + td beInput. + td maxLength: 1280. + td errorCount: 3. + td enableInterruptOnComplete. + td beTerminator. + td activate. + self frameListAt: 100 put: td. + ^ Array with: td with: buf. + +! ! + +!USBUHCIController methodsFor: 'accessing - interrupt register' stamp: 'KenD 28/Jun/2026 13:32:24'! +testInterruptBit: bit + ^ self interruptEnable anyMask: 1 << bit +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +testPort1StatusBit: bit + ^ self port1StatusControl anyMask: 1 << bit + +! ! + +!USBUHCIController methodsFor: 'accessing - port status/controll' stamp: 'KenD 28/Jun/2026 13:32:24'! +testPort2StatusBit: bit + ^ self port2StatusControl anyMask: 1 << bit + +! ! + +!USBUHCIController methodsFor: 'accessing - status' stamp: 'KenD 28/Jun/2026 13:32:24'! +testStatusBit: bit + ^ self status anyMask: 1 << bit +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'USBUHCIController class' category: 'SqueakNOS-Devices-USB'! +USBUHCIController class + instanceVariableNames: ''! + +!USBUHCIController class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +classCode + ^12 +! ! + +!USBUHCIController class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +classSubCode + ^3 +! ! + +!USBUHCIController class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + | pciEntry | + pciEntry := PCIBusEntry allValid + detect: [:e | + e classCode == self classCode and: [ + e classSubCode == self classSubCode and: [ + e programmingInterface == self programmingInterface]]] + ifNone: [^ self]. + + ^ self onPCIEntry: pciEntry computer: aComputer. + +! ! + +!USBUHCIController class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +onPCIEntry: aPCIBusEntry computer: aComputer + | answer | + answer := self onPort: aPCIBusEntry allIORanges first key. + + aPCIBusEntry + enableBusMastering; + enableIO; + " enable IRQ routing (legacy support)" + configShort: 16rC0 put: ((aPCIBusEntry configShort: 16rC0) bitOr: 1 << 13). + + " copyed from GRUB, not sure if needed or not:" + aPCIBusEntry latencyTimer < 32 ifTrue: [aPCIBusEntry latencyTimer: 32]. + + aComputer interruptController + addHandler: answer + forIRQ: aPCIBusEntry interruptLine. + + aComputer usbUHCIController: answer. + ^ answer + + +! ! + +!USBUHCIController class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +programmingInterface + ^0 +! ! + + +USBUHCIController initialize! + diff --git a/modules/NOS/External/Buffer.Class.st b/modules/NOS/External/Buffer.Class.st new file mode 100644 index 00000000..1946d0ca --- /dev/null +++ b/modules/NOS/External/Buffer.Class.st @@ -0,0 +1,65 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #Buffer category: 'SqueakNOS-External-Structures'! +Object subclass: #Buffer + instanceVariableNames: 'pointer size' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!Buffer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +address + ^pointer address. + +! ! + +!Buffer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +allocateSpace + pointer := Alien newC: size. +! ! + +!Buffer methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anAddress size: aNumberOfBytes + pointer := Alien forPointer: anAddress. + size := aNumberOfBytes. +! ! + +!Buffer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +basicSize + ^size. + +! ! + +!Buffer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents + | result | + result := ByteArray new: size. + pointer copyInto: result from: 1 to: size in: pointer startingAt: 1. + ^result. + +! ! + +!Buffer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: aByteArray + pointer replaceFrom: 1 to: aByteArray size with: aByteArray startingAt: 1. + +! ! + +!Buffer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^size. + +! ! + +!Buffer methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +size: aSize + ^size := aSize. + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Buffer class' category: 'SqueakNOS-External-Structures'! +Buffer class + instanceVariableNames: ''! + + diff --git a/modules/NOS/External/DisplayInformation.Class.st b/modules/NOS/External/DisplayInformation.Class.st new file mode 100644 index 00000000..d34e3d4b --- /dev/null +++ b/modules/NOS/External/DisplayInformation.Class.st @@ -0,0 +1,86 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #DisplayInformation category: 'SqueakNOS-External-Structures'! +ExternalStructure subclass: #DisplayInformation + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!DisplayInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address + "This method was automatically generated" + ^handle unsignedLongAt: 13 +! ! + +!DisplayInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address: anObject + "This method was automatically generated" + handle unsignedLongAt: 13 put: anObject +! ! + +!DisplayInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytesPerScanLine + "This method was automatically generated" + ^handle unsignedLongAt: 17 +! ! + +!DisplayInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytesPerScanLine: anObject + "This method was automatically generated" + handle unsignedLongAt: 17 put: anObject +! ! + +!DisplayInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +depth + "This method was automatically generated" + ^handle unsignedLongAt: 9 +! ! + +!DisplayInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +depth: anObject + "This method was automatically generated" + handle unsignedLongAt: 9 put: anObject +! ! + +!DisplayInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +height + "This method was automatically generated" + ^handle unsignedLongAt: 5 +! ! + +!DisplayInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +height: anObject + "This method was automatically generated" + handle unsignedLongAt: 5 put: anObject +! ! + +!DisplayInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +width + "This method was automatically generated" + ^handle unsignedLongAt: 1 +! ! + +!DisplayInformation methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +width: anObject + "This method was automatically generated" + handle unsignedLongAt: 1 put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'DisplayInformation class' category: 'SqueakNOS-External-Structures'! +DisplayInformation class + instanceVariableNames: ''! + +!DisplayInformation class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fields + ^#( + (width 'ulong') + (height 'ulong') + (depth 'ulong') + (address 'ulong') + (bytesPerScanLine 'ulong') + ) +! ! + + diff --git a/modules/NOS/External/ElfSectionHeaderTable.Class.st b/modules/NOS/External/ElfSectionHeaderTable.Class.st new file mode 100644 index 00000000..ebfcac61 --- /dev/null +++ b/modules/NOS/External/ElfSectionHeaderTable.Class.st @@ -0,0 +1,73 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ElfSectionHeaderTable category: 'SqueakNOS-External-Structures'! +ExternalStructure subclass: #ElfSectionHeaderTable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!ElfSectionHeaderTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address + "This method was automatically generated" + ^handle unsignedLongAt: 9 +! ! + +!ElfSectionHeaderTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address: anObject + "This method was automatically generated" + handle unsignedLongAt: 9 put: anObject +! ! + +!ElfSectionHeaderTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +number + "This method was automatically generated" + ^handle unsignedLongAt: 1 +! ! + +!ElfSectionHeaderTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +number: anObject + "This method was automatically generated" + handle unsignedLongAt: 1 put: anObject +! ! + +!ElfSectionHeaderTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +shndx + "This method was automatically generated" + ^handle unsignedLongAt: 13 +! ! + +!ElfSectionHeaderTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +shndx: anObject + "This method was automatically generated" + handle unsignedLongAt: 13 put: anObject +! ! + +!ElfSectionHeaderTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + "This method was automatically generated" + ^handle unsignedLongAt: 5 +! ! + +!ElfSectionHeaderTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size: anObject + "This method was automatically generated" + handle unsignedLongAt: 5 put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ElfSectionHeaderTable class' category: 'SqueakNOS-External-Structures'! +ElfSectionHeaderTable class + instanceVariableNames: ''! + +!ElfSectionHeaderTable class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fields + ^#( + (number 'ulong') + (size 'ulong') + (address 'ulong') + (shndx 'ulong') + ) +! ! + + diff --git a/modules/NOS/External/KernelModule.Class.st b/modules/NOS/External/KernelModule.Class.st new file mode 100644 index 00000000..d4a09ddf --- /dev/null +++ b/modules/NOS/External/KernelModule.Class.st @@ -0,0 +1,73 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #KernelModule category: 'SqueakNOS-External-Structures'! +ExternalStructure subclass: #KernelModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +end + "This method was automatically generated" + ^handle unsignedLongAt: 5 +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +end: anObject + "This method was automatically generated" + handle unsignedLongAt: 5 put: anObject +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +reserved + "This method was automatically generated" + ^handle unsignedLongAt: 13 +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +reserved: anObject + "This method was automatically generated" + handle unsignedLongAt: 13 put: anObject +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +start + "This method was automatically generated" + ^handle unsignedLongAt: 1 +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +start: anObject + "This method was automatically generated" + handle unsignedLongAt: 1 put: anObject +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +string + "This method was automatically generated" + ^handle unsignedLongAt: 9 +! ! + +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +string: anObject + "This method was automatically generated" + handle unsignedLongAt: 9 put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'KernelModule class' category: 'SqueakNOS-External-Structures'! +KernelModule class + instanceVariableNames: ''! + +!KernelModule class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fields + ^#( + (start 'ulong') + (end 'ulong') + (string 'ulong') + (reserved 'ulong') + ) +! ! + + diff --git a/modules/NOS/External/MultiBootInfo.Class.st b/modules/NOS/External/MultiBootInfo.Class.st new file mode 100644 index 00000000..6a17ad62 --- /dev/null +++ b/modules/NOS/External/MultiBootInfo.Class.st @@ -0,0 +1,327 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #MultiBootInfo category: 'SqueakNOS-External-Structures'! +ExternalStructure subclass: #MultiBootInfo + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +aoutSymbol + "This method was automatically generated" + ^SymbolTable fromHandle: (handle structAt: 29 length: 16) +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +aoutSymbol: anObject + "This method was automatically generated" + handle structAt: 29 put: anObject getHandle length: 16. +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +apmTable + "This method was automatically generated" + ^handle unsignedLongAt: 85 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +apmTable: anObject + "This method was automatically generated" + handle unsignedLongAt: 85 put: anObject +! ! + +!MultiBootInfo methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +areMemoryAddressesValid + "Addresses are valid if first bit of the flags is set" + ^(self flags bitAnd: 16r00000001) = 16r00000001 +! ! + +!MultiBootInfo methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +areModulesValid + "Modules are valid if third bit of the flags is set" + ^(self flags bitAnd: 16r00000004) = 16r00000004 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bootDevice + "This method was automatically generated" + ^handle unsignedLongAt: 13 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bootDevice: anObject + "This method was automatically generated" + handle unsignedLongAt: 13 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bootLoaderName + "This method was automatically generated" + ^handle unsignedLongAt: 81 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bootLoaderName: anObject + "This method was automatically generated" + handle unsignedLongAt: 81 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +cmdLine + "This method was automatically generated" + ^handle unsignedLongAt: 17 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +cmdLine: anObject + "This method was automatically generated" + handle unsignedLongAt: 17 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +configTable + "This method was automatically generated" + ^handle unsignedLongAt: 77 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +configTable: anObject + "This method was automatically generated" + handle unsignedLongAt: 77 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +drivesAddress + "This method was automatically generated" + ^handle unsignedLongAt: 73 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +drivesAddress: anObject + "This method was automatically generated" + handle unsignedLongAt: 73 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +drivesLength + "This method was automatically generated" + ^handle unsignedLongAt: 69 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +drivesLength: anObject + "This method was automatically generated" + handle unsignedLongAt: 69 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +elfSection + "This method was automatically generated" + ^ElfSectionHeaderTable fromHandle: (handle structAt: 45 length: 16) +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +elfSection: anObject + "This method was automatically generated" + handle structAt: 45 put: anObject getHandle length: 16. +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +flags + "This method was automatically generated" + ^handle unsignedLongAt: 1 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +flags: anObject + "This method was automatically generated" + handle unsignedLongAt: 1 put: anObject +! ! + +!MultiBootInfo methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isMemoryMapValid + "Modules are valid if six bit of the flags is set" + ^(self flags bitAnd: 16r00000020) = 16r00000020 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +memLower + "This method was automatically generated" + ^handle unsignedLongAt: 5 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +memLower: anObject + "This method was automatically generated" + handle unsignedLongAt: 5 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +memUpper + "This method was automatically generated" + ^handle unsignedLongAt: 9 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +memUpper: anObject + "This method was automatically generated" + handle unsignedLongAt: 9 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mmapAddress + "This method was automatically generated" + ^handle unsignedLongAt: 65 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mmapAddress: anObject + "This method was automatically generated" + handle unsignedLongAt: 65 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mmapLength + "This method was automatically generated" + ^handle unsignedLongAt: 61 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mmapLength: anObject + "This method was automatically generated" + handle unsignedLongAt: 61 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +modsAddress + "This method was automatically generated" + ^handle unsignedLongAt: 25 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +modsAddress: anObject + "This method was automatically generated" + handle unsignedLongAt: 25 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +modsCount + "This method was automatically generated" + ^handle unsignedLongAt: 21 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +modsCount: anObject + "This method was automatically generated" + handle unsignedLongAt: 21 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeControlInfo + "This method was automatically generated" + ^handle unsignedLongAt: 89 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeControlInfo: anObject + "This method was automatically generated" + handle unsignedLongAt: 89 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeInterfaceName + "This method was automatically generated" + ^handle unsignedLongAt: 109 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeInterfaceName: anObject + "This method was automatically generated" + handle unsignedLongAt: 109 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeInterfaceOffset + "This method was automatically generated" + ^handle unsignedLongAt: 105 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeInterfaceOffset: anObject + "This method was automatically generated" + handle unsignedLongAt: 105 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeInterfaceSegment + "This method was automatically generated" + ^handle unsignedLongAt: 101 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeInterfaceSegment: anObject + "This method was automatically generated" + handle unsignedLongAt: 101 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeMode + "This method was automatically generated" + ^handle unsignedLongAt: 97 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeMode: anObject + "This method was automatically generated" + handle unsignedLongAt: 97 put: anObject +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeModeInfo + "This method was automatically generated" + ^handle unsignedLongAt: 93 +! ! + +!MultiBootInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +vbeModeInfo: anObject + "This method was automatically generated" + handle unsignedLongAt: 93 put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MultiBootInfo class' category: 'SqueakNOS-External-Structures'! +MultiBootInfo class + instanceVariableNames: ''! + +!MultiBootInfo class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fields + ^#( + (flags 'ulong') + (memLower 'ulong') + (memUpper 'ulong') + (bootDevice 'ulong') + (cmdLine 'ulong') + (modsCount 'ulong') + (modsAddress 'ulong') + (aoutSymbol 'SymbolTable') + (elfSection 'ElfSectionHeaderTable') + (mmapLength 'ulong') + (mmapAddress 'ulong') + (drivesLength 'ulong') + (drivesAddress 'ulong') + (configTable 'ulong') + (bootLoaderName 'ulong') + (apmTable 'ulong') + (vbeControlInfo 'ulong') + (vbeModeInfo 'ulong') + (vbeMode 'ulong') + (vbeInterfaceSegment 'ulong') + (vbeInterfaceOffset 'ulong') + (vbeInterfaceName 'ulong') + ) + + +! ! + + diff --git a/modules/NOS/External/MultiBootMemoryMap.Class.st b/modules/NOS/External/MultiBootMemoryMap.Class.st new file mode 100644 index 00000000..9a965367 --- /dev/null +++ b/modules/NOS/External/MultiBootMemoryMap.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #MultiBootMemoryMap category: 'SqueakNOS-External-Structures'! +ExternalStructure subclass: #MultiBootMemoryMap + instanceVariableNames: 'size' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!MultiBootMemoryMap methodsFor: 'collection' stamp: 'KenD 28/Jun/2026 13:32:25'! +do: aBlock + | memoryAddress entry | + memoryAddress := self address. + [memoryAddress - self address > self size] + whileFalse: + [entry := MultiBootMemoryMapEntry fromHandle: (ExternalAddress new fromInteger: memoryAddress). + aBlock value: entry. + memoryAddress := memoryAddress + entry size] +! ! + +!MultiBootMemoryMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^size +! ! + +!MultiBootMemoryMap methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size: anInteger + size := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MultiBootMemoryMap class' category: 'SqueakNOS-External-Structures'! +MultiBootMemoryMap class + instanceVariableNames: ''! + +!MultiBootMemoryMap class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +fromHandle: handle size: anInteger + ^(self fromHandle: handle) size: anInteger +! ! + + diff --git a/modules/NOS/External/MultiBootMemoryMapEntry.Class.st b/modules/NOS/External/MultiBootMemoryMapEntry.Class.st new file mode 100644 index 00000000..d2e1db85 --- /dev/null +++ b/modules/NOS/External/MultiBootMemoryMapEntry.Class.st @@ -0,0 +1,73 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #MultiBootMemoryMapEntry category: 'SqueakNOS-External-Structures'! +ExternalStructure subclass: #MultiBootMemoryMapEntry + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!MultiBootMemoryMapEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +baseAddress + "This method was automatically generated" + ^handle doubleAt: 5 +! ! + +!MultiBootMemoryMapEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +baseAddress: anObject + "This method was automatically generated" + handle doubleAt: 5 put: anObject +! ! + +!MultiBootMemoryMapEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + "This method was automatically generated" + ^handle doubleAt: 13 +! ! + +!MultiBootMemoryMapEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length: anObject + "This method was automatically generated" + handle doubleAt: 13 put: anObject +! ! + +!MultiBootMemoryMapEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + "This method was automatically generated" + ^handle unsignedLongAt: 1 +! ! + +!MultiBootMemoryMapEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size: anObject + "This method was automatically generated" + handle unsignedLongAt: 1 put: anObject +! ! + +!MultiBootMemoryMapEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + "This method was automatically generated" + ^handle unsignedLongAt: 21 +! ! + +!MultiBootMemoryMapEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type: anObject + "This method was automatically generated" + handle unsignedLongAt: 21 put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MultiBootMemoryMapEntry class' category: 'SqueakNOS-External-Structures'! +MultiBootMemoryMapEntry class + instanceVariableNames: ''! + +!MultiBootMemoryMapEntry class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fields + ^#( + (size 'ulong') + (baseAddress 'double') + (length 'double') + (type 'ulong') + ) +! ! + + diff --git a/modules/NOS/External/ReadonlyPage.Class.st b/modules/NOS/External/ReadonlyPage.Class.st new file mode 100644 index 00000000..617f6094 --- /dev/null +++ b/modules/NOS/External/ReadonlyPage.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ReadonlyPage category: 'SqueakNOS-External-Structures'! +ExternalStructure subclass: #ReadonlyPage + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!ReadonlyPage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents + "This method was automatically generated" + ^(Buffer at: self address + 8 size: 4096) contents + +! ! + +!ReadonlyPage methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +fields + "self defineFields" + ^#( + (virtual 'ulong') + (physical 'ulong') + (contents 'string' 4096) + ) +! ! + +!ReadonlyPage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +physical + "This method was automatically generated" + ^handle unsignedLongAt: 5 +! ! + +!ReadonlyPage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +physical: anObject + "This method was automatically generated" + handle unsignedLongAt: 5 put: anObject +! ! + +!ReadonlyPage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +virtual + "This method was automatically generated" + ^handle unsignedLongAt: 1 +! ! + +!ReadonlyPage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +virtual: anObject + "This method was automatically generated" + handle unsignedLongAt: 1 put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ReadonlyPage class' category: 'SqueakNOS-External-Structures'! +ReadonlyPage class + instanceVariableNames: ''! + + diff --git a/modules/NOS/External/SnapshotInfo.Class.st b/modules/NOS/External/SnapshotInfo.Class.st new file mode 100644 index 00000000..6711fde4 --- /dev/null +++ b/modules/NOS/External/SnapshotInfo.Class.st @@ -0,0 +1,87 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #SnapshotInfo category: 'SqueakNOS-External-Structures'! +ExternalStructure subclass: #SnapshotInfo + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!SnapshotInfo methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +fields + "self defineFields" + ^#( + (saved 'ulong') + (toSave 'ulong') + (pages 'ReadonlyPage*') + ) +! ! + +!SnapshotInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pageFor: anAddress + "This method was automatically generated" + | pages start pageDescriptorAddress virtualAddress | + pages := OrderedCollection new: self toSave. + start := handle pointerAt: 9. + 0 to: self saved - 1 do: [:index | + pageDescriptorAddress := start + (index * ReadonlyPage byteSize). + virtualAddress := pageDescriptorAddress unsignedLongAt: 1. + (anAddress between: virtualAddress and: virtualAddress + 4095) ifTrue: + [^ReadonlyPage fromHandle: pageDescriptorAddress] + ]. + ^nil +! ! + +!SnapshotInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pages + "This method was automatically generated" + | pages start | + pages := OrderedCollection new: self toSave. + start := handle pointerAt: 9. + 0 to: self toSave - 1 do: [:index | pages add: (ReadonlyPage fromHandle: start + (index * ReadonlyPage byteSize))]. + ^pages +! ! + +!SnapshotInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pages: anObject + "This method was automatically generated (and then modified by hand)" + handle pointerAt: 9 put: anObject. +! ! + +!SnapshotInfo methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +resetPages + | address | + address := ExternalAddress allocate: self toSave * ReadonlyPage byteSize. + self pages: address +! ! + +!SnapshotInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +saved + "This method was automatically generated" + ^handle unsignedLongAt: 1 +! ! + +!SnapshotInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +saved: anObject + "This method was automatically generated" + handle unsignedLongAt: 1 put: anObject +! ! + +!SnapshotInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +toSave + "This method was automatically generated" + ^handle unsignedLongAt: 5 +! ! + +!SnapshotInfo methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +toSave: anObject + "This method was automatically generated" + handle unsignedLongAt: 5 put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SnapshotInfo class' category: 'SqueakNOS-External-Structures'! +SnapshotInfo class + instanceVariableNames: ''! + + diff --git a/modules/NOS/External/SymbolTable.Class.st b/modules/NOS/External/SymbolTable.Class.st new file mode 100644 index 00000000..1b65a4ae --- /dev/null +++ b/modules/NOS/External/SymbolTable.Class.st @@ -0,0 +1,75 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #SymbolTable category: 'SqueakNOS-External-Structures'! +ExternalStructure subclass: #SymbolTable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!SymbolTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address + "This method was automatically generated" + ^handle unsignedLongAt: 9 +! ! + +!SymbolTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address: anObject + "This method was automatically generated" + handle unsignedLongAt: 9 put: anObject +! ! + +!SymbolTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +reserved + "This method was automatically generated" + ^handle unsignedLongAt: 13 +! ! + +!SymbolTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +reserved: anObject + "This method was automatically generated" + handle unsignedLongAt: 13 put: anObject +! ! + +!SymbolTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +strSize + "This method was automatically generated" + ^handle unsignedLongAt: 5 +! ! + +!SymbolTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +strSize: anObject + "This method was automatically generated" + handle unsignedLongAt: 5 put: anObject +! ! + +!SymbolTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +tabSize + "This method was automatically generated" + ^handle unsignedLongAt: 1 +! ! + +!SymbolTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +tabSize: anObject + "This method was automatically generated" + handle unsignedLongAt: 1 put: anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SymbolTable class' category: 'SqueakNOS-External-Structures'! +SymbolTable class + instanceVariableNames: ''! + +!SymbolTable class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fields + ^#( + (tabSize 'ulong') + (strSize 'ulong') + (address 'ulong') + (reserved 'ulong') + ) + + +! ! + + diff --git a/modules/NOS/External/VMBridge.Class.st b/modules/NOS/External/VMBridge.Class.st new file mode 100644 index 00000000..ce9d5423 --- /dev/null +++ b/modules/NOS/External/VMBridge.Class.st @@ -0,0 +1,146 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #VMBridge category: 'SqueakNOS-External-Structures'! +ExternalStructure subclass: #VMBridge + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-External-Structures'! +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +image + "This method was automatically generated" + ^ExternalData fromHandle: (handle pointerAt: 25) type: ExternalType void asPointerType +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +image: anObject + "This method was automatically generated" + handle pointerAt: 25 put: anObject getHandle. +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +inPageFault + ^handle unsignedLongAt: 53 +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +inPageFault: anInteger + handle unsignedLongAt: 53 put: anInteger +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +multiboot + "This method was automatically generated" + ^MultiBootInfo fromHandle: (handle pointerAt: 21) +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +multiboot: anObject + "This method was automatically generated" + handle pointerAt: 21 put: anObject getHandle. +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pageFaultAddress + ^handle unsignedLongAt: 57 +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pageFaultAddress: anInteger + handle unsignedLongAt: 57 put: anInteger +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pageFaultHandlerEntry + ^handle unsignedLongAt: 37 +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pageFaultHandlerEntry: aCallBackAddress + "This method was automatically generated" + handle unsignedLongAt: 37 put: aCallBackAddress +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshotEndAddress + "This method was automatically generated" + ^handle unsignedLongAt: 33 +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshotEndAddress: anObject + "This method was automatically generated" + handle unsignedLongAt: 33 put: anObject +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshotInfo + "This method was automatically generated and modified by hand" + ^SnapshotInfo fromHandle: handle + 40 +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshotInfo: anObject + "This method was automatically generated" + handle structAt: 41 put: anObject getHandle length: 12. +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshotStartAddress + "This method was automatically generated" + ^handle unsignedLongAt: 29 +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshotStartAddress: anObject + "This method was automatically generated" + handle unsignedLongAt: 29 put: anObject +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +totalPageFaults + ^handle unsignedLongAt: 61 +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +totalPageFaults: anInteger + handle unsignedLongAt: 61 put: anInteger +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +video + "This method was automatically generated" + ^DisplayInformation fromHandle: (handle structAt: 1 length: 20) +! ! + +!VMBridge methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +video: anObject + "This method was automatically generated" + handle structAt: 1 put: anObject getHandle length: 20. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'VMBridge class' category: 'SqueakNOS-External-Structures'! +VMBridge class + instanceVariableNames: ''! + +!VMBridge class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fields + ^#( + (video 'DisplayInformation') + (multiboot 'MultiBootInfo*') + (image 'void*') + (snapshotStartAddress 'ulong') + (snapshotEndAddress 'ulong') + (pageFaultHandlerEntry 'void*') + (snapshotInfo 'SnapshotInfo') + ) +! ! + +!VMBridge class methodsFor: 'system startup' stamp: 'KenD 28/Jun/2026 13:32:25'! +install + Computer current ifNotNil: [:computer | computer initializeBridge] +! ! + + diff --git a/modules/NOS/FileSupport/DeviceStream.Class.st b/modules/NOS/FileSupport/DeviceStream.Class.st new file mode 100644 index 00000000..312faa75 --- /dev/null +++ b/modules/NOS/FileSupport/DeviceStream.Class.st @@ -0,0 +1,73 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #DeviceStream category: 'SqueakNOS-FileSupport'! +ReadWriteStream subclass: #DeviceStream + instanceVariableNames: 'device' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-FileSupport'! +!DeviceStream commentStamp: '' prior: 0! + +a DeviceStream is a ReadWriteStream on top of a Device + +a Device must understand +#next, #nextPut: , #reopen, #isOpen, #flush, #close, #dataAvailable +! + +!DeviceStream methodsFor: 'fileIn/Out' stamp: 'KenD 28/Jun/2026 13:32:25'! +atEnd + ^ device isOpen not +! ! + +!DeviceStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + device close +! ! + +!DeviceStream methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +dataAvailable + ^ device dataAvailable +! ! + +!DeviceStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +device: aDevice + device := aDevice +! ! + +!DeviceStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +flush + device flush +! ! + +!DeviceStream methodsFor: 'fileIn/Out' stamp: 'KenD 28/Jun/2026 13:32:25'! +next + ^ device next +! ! + +!DeviceStream methodsFor: 'fileIn/Out' stamp: 'KenD 28/Jun/2026 13:32:25'! +next: anInteger + ^ device next: anInteger +! ! + +!DeviceStream methodsFor: 'fileIn/Out' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: anObject + ^ device nextPut: anObject +! ! + +!DeviceStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +reopen + ^ device reopen +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'DeviceStream class' category: 'SqueakNOS-FileSupport'! +DeviceStream class + instanceVariableNames: ''! + +!DeviceStream class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aDevice + ^ self basicNew device: aDevice +! ! + + diff --git a/modules/NOS/FileSupport/NopsysResolver.Class.st b/modules/NOS/FileSupport/NopsysResolver.Class.st new file mode 100644 index 00000000..7869bf6a --- /dev/null +++ b/modules/NOS/FileSupport/NopsysResolver.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NopsysResolver category: 'SqueakNOS-FileSupport'! +PlatformResolver subclass: #NopsysResolver + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-FileSupport'! +!NopsysResolver methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:32:25'! +resolve: anObject + Computer showCallTrace. + ^nil +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NopsysResolver class' category: 'SqueakNOS-FileSupport'! +NopsysResolver class + instanceVariableNames: ''! + +!NopsysResolver class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +platformName + ^'SqueakNOS' +! ! + + diff --git a/modules/NOS/FileSupport/ParagraphEditorWithBindings.Class.st b/modules/NOS/FileSupport/ParagraphEditorWithBindings.Class.st new file mode 100644 index 00000000..7ce7e548 --- /dev/null +++ b/modules/NOS/FileSupport/ParagraphEditorWithBindings.Class.st @@ -0,0 +1,29 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ParagraphEditorWithBindings category: 'SqueakNOS-FileSupport'! +Object subclass: #ParagraphEditorWithBindings + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-FileSupport'! +!ParagraphEditorWithBindings methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +bindingOf: key + model ifNil: [model := Dictionary new]. + (model includesKey: key) ifFalse: [model at: key put: nil]. + ^ model associationAt: key +! ! + +!ParagraphEditorWithBindings methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +evaluate: aString + paragraph := aString asParagraph. + self selectAll. + ^ self evaluateSelection +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ParagraphEditorWithBindings class' category: 'SqueakNOS-FileSupport'! +ParagraphEditorWithBindings class + instanceVariableNames: ''! + + diff --git a/modules/NOS/FileSupport/RemoteFileDirectory.Class.st b/modules/NOS/FileSupport/RemoteFileDirectory.Class.st new file mode 100644 index 00000000..db9cf778 --- /dev/null +++ b/modules/NOS/FileSupport/RemoteFileDirectory.Class.st @@ -0,0 +1,63 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #RemoteFileDirectory category: 'SqueakNOS-FileSupport'! +Object subclass: #RemoteFileDirectory + instanceVariableNames: 'channel' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-FileSupport'! +!RemoteFileDirectory methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +channel + channel + ifNil: [channel := RemoteObjectChannel for: self using: 'FileDirectory on: ' , pathName pathName storeString]. + ^ channel +! ! + +!RemoteFileDirectory methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +channel: aStream + channel := aStream +! ! + +!RemoteFileDirectory methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +primCreateDirectory: fullPath + ^ self channel remotePerform: #primCreateDirectory: with: fullPath +! ! + +!RemoteFileDirectory methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +primDeleteDirectory: fullPath + ^ self channel remotePerform: #primDeleteDirectory: with: fullPath +! ! + +!RemoteFileDirectory methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +primDeleteFileNamed: aFileName + ^ self channel remotePerform: #primDeleteFileNamed: with: aFileName +! ! + +!RemoteFileDirectory methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +primLookupEntryIn: fullPath index: index + ^ self channel remotePerform: #primLookupEntryIn:index: with: fullPath with: index +! ! + +!RemoteFileDirectory methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +primRename: oldFileFullName to: newFileFullName + ^ self channel remotePerform: #primRename:to: with: oldFileFullName with: newFileFullName. + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RemoteFileDirectory class' category: 'SqueakNOS-FileSupport'! +RemoteFileDirectory class + instanceVariableNames: ''! + +!RemoteFileDirectory class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +isActiveDirectoryClass + ^ Computer isSqueakNOS +! ! + +!RemoteFileDirectory class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +pathNameDelimiter + ^ $/ +! ! + + diff --git a/modules/NOS/FileSupport/RemoteMultiByteFileStream.Class.st b/modules/NOS/FileSupport/RemoteMultiByteFileStream.Class.st new file mode 100644 index 00000000..ef085d25 --- /dev/null +++ b/modules/NOS/FileSupport/RemoteMultiByteFileStream.Class.st @@ -0,0 +1,203 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #RemoteMultiByteFileStream category: 'SqueakNOS-FileSupport'! +MultiByteFileStream subclass: #RemoteMultiByteFileStream + instanceVariableNames: 'channel' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-FileSupport'! +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +atEnd + ^ self channel remotePerform: #atEnd +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +basicNext + ^ self channel remotePerform: #basicNext +! ! + +!RemoteMultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +channel + channel + ifNil: [channel := RemoteObjectChannel for: self using: 'MultiByteFileStream new']. + ^ channel +! ! + +!RemoteMultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +channel: aStream + channel := aStream +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + ^ self channel remotePerform: #close +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +closed + ^ self channel remotePerform: #closed +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +ensureOpen + ^ self channel remotePerform: #ensureOpen +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +finalize + ^ self channel remotePerform: #finalize +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +flush + ^ self channel remotePerform: #flush +! ! + +!RemoteMultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +next: anInteger + ^ self channel remotePerform: #next: with: anInteger +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +next: anInteger putAll: aString startingAt: startIndex + ^ self nextPutAll: (aString copyFrom: startIndex to: startIndex + anInteger) +! ! + +!RemoteMultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextChunk + ^ self channel remotePerform: #nextChunk +! ! + +!RemoteMultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextChunkText + ^ self channel remotePerform: #nextChunkText +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: char + ^ self channel remotePerform: #nextPut: with: char +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPutAll: aString + ^ self channel remotePerform: #nextPutAll: with: aString +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +open: fileName forWrite: writableFlag + name := fileName. + rwmode := writableFlag. + ^ self channel remotePerform: #open:forWrite: with: fileName with: writableFlag + +! ! + +!RemoteMultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +peek + ^ self channel remotePerform: #peek +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +position + ^ self channel remotePerform: #position +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +position: pos + ^ self channel remotePerform: #position: with: pos +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primAtEnd: id + self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primClose: id + self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primCloseNoError: id + self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primFlush: id + self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primGetPosition: id + ^ self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primOpen: fileName writable: writableFlag + self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primRead: id into: byteArray startingAt: startIndex count: count + "The main problem with this primitive is that it replaces the contents of the string, + and that is not reflected in the answer. We'll need to hack something if needed" + self shouldNotImplement. +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primSetPosition: id to: anInteger + self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primSize: id + self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primSizeNoError: id + self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primTruncate: id to: anInteger + self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primWrite: id from: stringOrByteArray startingAt: startIndex count: count + + self shouldNotImplement +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +reopen + ^ self channel remotePerform: #reopen +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ self channel remotePerform: #size +! ! + +!RemoteMultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +skipSeparators + ^ self channel remotePerform: #skipSeparators +! ! + +!RemoteMultiByteFileStream methodsFor: 'remote file compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +truncate: pos + ^ self channel remotePerform: #truncate: with: pos +! ! + +!RemoteMultiByteFileStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +upTo: aCharacter + ^ self channel remotePerform: #upTo: with: aCharacter +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RemoteMultiByteFileStream class' category: 'SqueakNOS-FileSupport'! +RemoteMultiByteFileStream class + instanceVariableNames: ''! + + diff --git a/modules/NOS/FileSupport/RemoteObjectChannel.Class.st b/modules/NOS/FileSupport/RemoteObjectChannel.Class.st new file mode 100644 index 00000000..0898e902 --- /dev/null +++ b/modules/NOS/FileSupport/RemoteObjectChannel.Class.st @@ -0,0 +1,267 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #RemoteObjectChannel category: 'SqueakNOS-FileSupport'! +Object subclass: #RemoteObjectChannel + instanceVariableNames: 'handle stream object' + classVariableNames: 'Channels MainChannelStream' + poolDictionaries: '' + category: 'SqueakNOS-FileSupport'! +!RemoteObjectChannel commentStamp: '' prior: 0! + +I'm a channel used on the client side of an RPC communication. I know how to perform: something on a remote object and return the answer. Classes must be mirrored on both images + +" To start a remoting server, do the next in a standard squeak." +RemoteObjectChannel stream socket closeAndDestroy. +RemoteObjectChannel waitConnectionsOnPort: 1234. +[RemoteObjectChannel performNext] repeat.. + +" To connect to a remoting server from a standard Squeak (testing) do:" +RemoteObjectChannel conRemoteObjectChannel stream socket closeAndDestroy. +nectSocketTo: NetNameResolver localHostAddress onPort: 1234 + +" To setup the remoting client inside SqueakNOS, do the next" +Computer current defaultSerialPort open. +RemoteObjectChannel stream: (DeviceStream on: Computer current defaultSerialPort) + +" To test do:" +(RemoteMultiByteStream oldFileNamed: 'TestFile.st') fileIn + +" If you want to change default File and Directory classes, edit the next methods:" +activeDirectoryClass + ^ RemoteFileDirectory + +concreteStream + ^ RemoteMultiByteFileStream + +! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +forget + ^ self class forgetOnServer: self handle +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +handle + ^ handle +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +handle: anInteger + handle := anInteger +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +object + ^ object +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +object: anObject + object := anObject +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePerform: aSelector + ^ self remotePerform: aSelector withString: '#()' +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePerform: aSelector with: arg1 + ^ self remotePerform: aSelector withArguments: (Array with: arg1) +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePerform: aSelector with: arg1 with: arg2 + ^ self remotePerform: aSelector withArguments: (Array with: arg1 with: arg2) +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePerform: aSelector with: arg1 with: arg2 with: arg3 + ^ self remotePerform: aSelector withArguments: (Array with: arg1 with: arg2 with: arg3) +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePerform: aSelector with: arg1 with: arg2 with: arg3 with: arg4 + ^ self remotePerform: aSelector withArguments: (Array with: arg1 with: arg2 with: arg3 with: arg4) +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePerform: aSelector withArguments: arguments + | strm | + strm := WriteStream on: ''. + strm nextPut: ${. + arguments do: [:each | + strm + store: each; + nextPut: $ ; + nextPut: $.]. + + ^ self remotePerform: aSelector withString: strm contents allButLast, '}' + + +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePerform: aSelector withString: argumentsString + | answer | + self stream + nextPut: $>; " query " + int32: self handle; + string: aSelector; + string: argumentsString; + flush. + + [self stream next = $< asciiValue] whileFalse. + + answer := (self stream next: self stream int32) asString. + ^ answer = 'self' ifTrue: [self object] ifFalse: [Compiler evaluate: answer]. + +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +stream + ^ stream +! ! + +!RemoteObjectChannel methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +stream: aStream + stream := aStream +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RemoteObjectChannel class' category: 'SqueakNOS-FileSupport'! +RemoteObjectChannel class + instanceVariableNames: 'Channels MainChannelStream'! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +channels + "only used in server's side. + In client side there is no need to mantain the Dictionary, as every Channel knows its handle" + ^ Channels ifNil: [ + Channels := Dictionary new + at: 0 put: (self new + handle: 0; + object: self; + stream: self stream); + yourself. + ] +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +connectSocketTo: ipAddress onPort: port + self stream: (SocketStream openConnectionToHost: ipAddress port: port) binary. + +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +for: anObject using: contructorString + | handle | + handle := (self channels at: 0) + remotePerform: #newOnServerFor: + withString: '{',contructorString,'}'. + + ^ self new + handle: handle; + stream: self stream; + object: anObject + +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +forget: aHandle + self channels + removeKey: aHandle +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +forgetOnServer: aHandle + " called of client side " + (self channels at: 0) + remotePerform: #forget: + withString: '#(',aHandle printString,')'. +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +installOn: aComputer + | serial | + serial := Computer current defaultSerialPort. + serial ifNil: [^self]. + serial open. + self stream: (DeviceStream on: serial). + [[RemoteObjectChannel performNext] repeat] fork. + +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +newHandle + | answer | + [answer := SmallInteger maxVal atRandom. + self channels includesKey: answer] whileTrue. + ^ answer +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +newOnServerFor: anObject + | handle | + handle := self newHandle. + self channels at: handle put: ( + self new + handle: handle; + object: anObject). " no need to set the stream on the server side " + ^ handle +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +objectForHandle: handle + ^ (self channels at: handle ifAbsent: [^ nil]) object +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +performNext + "server side" + | strm object selector arguments answer | + strm := self stream. + + [strm next = $> asciiValue] whileFalse. + + object := strm int32. + selector := strm string asSymbol. + arguments := strm string. + + object := self objectForHandle: object. + arguments := Compiler evaluate: arguments. + + [ answer :=object perform: selector withArguments: arguments. + answer := answer == object + ifTrue: [#self] + ifFalse: [answer storeString]. + ] ifError: [:msg :receiver | answer := 'Error signal: ', msg storeString]. + + strm + nextPut: $<; + int32: answer size; + nextPutAll: answer; + flush. + +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +stream + ^ MainChannelStream +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +stream: aStream + MainChannelStream := aStream. + Channels := nil. +! ! + +!RemoteObjectChannel class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +waitConnectionsOnPort: port + | s | + s := Socket new listenOn: port backlogSize: 10. + self stream: (SocketStream on: (s waitForAcceptFor: 1000)) binary. +! ! + + diff --git a/modules/NOS/FileSupport/RemoteWorkspace.Class.st b/modules/NOS/FileSupport/RemoteWorkspace.Class.st new file mode 100644 index 00000000..ceaec3b3 --- /dev/null +++ b/modules/NOS/FileSupport/RemoteWorkspace.Class.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #RemoteWorkspace category: 'SqueakNOS-FileSupport'! +Workspace subclass: #RemoteWorkspace + instanceVariableNames: 'remote' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-FileSupport'! +!RemoteWorkspace methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +evaluate: aStream + ^ remote remotePerform: #evaluate: with: aStream upToEnd. +! ! + +!RemoteWorkspace methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + remote := RemoteObjectChannel for: self using: 'ParagraphEditorWithBindings new' +! ! + +!RemoteWorkspace methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +isRemote + ^ true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RemoteWorkspace class' category: 'SqueakNOS-FileSupport'! +RemoteWorkspace class + instanceVariableNames: ''! + + +RemoteWorkspace initialize! + diff --git a/modules/NOS/FileSystems/FAT32/ExampleFAT32FileSystemTest.Class.st b/modules/NOS/FileSystems/FAT32/ExampleFAT32FileSystemTest.Class.st new file mode 100644 index 00000000..fd5b6e33 --- /dev/null +++ b/modules/NOS/FileSystems/FAT32/ExampleFAT32FileSystemTest.Class.st @@ -0,0 +1,235 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ExampleFAT32FileSystemTest category: 'SqueakNOS-Filesystems-FAT32'! +TestCase subclass: #ExampleFAT32FileSystemTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems-FAT32'! +!ExampleFAT32FileSystemTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +createTempFile: tempFileName from: existingFileName do: aTriArgsBlock + | filesystem root original clone | + filesystem := self openRawBig. + root := filesystem root. + original := root files detect: [ :file | file name asLowercase = existingFileName ]. + (root files noneSatisfy: [ :file | file name asLowercase = tempFileName ]) + ifFalse: [ self error: 'Temporary file already exists.' ]. + [ clone := root newFileNamed: tempFileName. + clone readWriteStream nextPutAll: original readStream contents. + aTriArgsBlock value: original value: clone value: filesystem ] + ensure: [ root removeFileNamed: tempFileName. + (root files noneSatisfy: [ :file | file name asLowercase = tempFileName ]) + ifFalse: [ self error: 'Couldn''t delete temporary file' ] ] +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +openDiskFilesystem + | stream device | + stream := StandardFileStream fileNamed: './testdata/ExampleFAT32.raw'. + device := BlockDeviceOnStream on: stream blockSize: 512. + ^ device primaryFilesystem +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +openDiskFilesystem: fileName + | stream device | + stream := StandardFileStream fileNamed: fileName. + device := BlockDeviceOnStream on: stream blockSize: 512. + ^ device primaryFilesystem +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +openRawBig + ^ self openRawFilesystem: './testdata/FAT32Partition.raw' +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +openRawFilesystem: fileName + | stream | + "We create a copy so that in the worse case we don't break the test filesystem" + stream := StandardFileStream fileNamed: fileName. + ^ (FAT32FileSystem on: stream binary contents) open +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +openRawSmall +^self openRawFilesystem: './testdata/FAT32PartitionSmall.raw' +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test010EmptyFile + " + self new test010EmptyFile + " + + | empty | + empty := self openRawSmall root files + detect: [ :file | file name asLowercase = 'empty.txt' ] + ifNone: [ self assert: false ]. + self assert: empty readStream contents isEmpty +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test015CreateAndRemoveFile + | root test name | + root := self openRawSmall root. + name := 'test.st'. + self assert: (root files noneSatisfy: [ :file | file name asLowercase = name ]). + root newFileNamed: name. + test := root files detect: [ :file | file name asLowercase = name ] ifNone: [ self assert: false ]. + self assert: test readStream contents isEmpty. + root removeFileNamed: name. + self assert: (root files noneSatisfy: [ :file | file name asLowercase = name ]) +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test020AsciiFile + " + self new test020AsciiFile + " + + | ascii | + ascii := self openRawSmall root files detect: [ :file | file name asLowercase = 'ascii' ]. + self assert: ascii readStream contents = ('zaraza' , String lf) +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test021AsciiFile + | ascii | + ascii := self openRawSmall root fileNamed: 'ascii'. + self assert: ascii readStream contents = ('zaraza' , String lf) +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test025SmallFileWrite + | root name small stream | + root := self openRawSmall root. + name := 'small.st'. + self assert: (root files noneSatisfy: [ :file | file name asLowercase = name ]). + small := root newFileNamed: name. + stream := small readWriteStream. + stream nextPutAll: 'zaraza test small'. + self assert: (root fileNamed: name) readStream contents = 'zaraza test small' + +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test030LargeFileRead + "I open a file bigger than one cluster and check it's content to match what is written by the testing filesystem generator script" + + | fs bytesPerCluster name large contents | + fs := self openRawBig. + bytesPerCluster := fs bytesPerCluster. + name := fs pureFAT32FilenameFor: 'moreth~2'. + large := fs root fileNamed: name. + contents := large readStream contents asString trimmed. + self + assert: contents size > bytesPerCluster; + assert: (contents first: 13) = '1234567890abc'; + assert: (contents last: 13) = '1234567890abc' +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test040DeepDirectory + | directory | + directory := self openRawBig directoryNamed: '/dira'. + self + assert: directory directories size = 0; + assert: (directory fileExists: 'file.txt') +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test050LargeFileCopy + self + createTempFile: 'morecopy.st' + from: 'moreth~2' + do: + [ :original :clone :filesystem | self assert: original readStream contents equals: clone readStream contents ] +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test060LargeFileAppend + self + createTempFile: 'morecopy.st' + from: 'moreth~2' + do: [ :original :clone :filesystem | + | stream | + stream := clone readWriteStream. + stream setToEnd. + stream nextPutAll: 'Goodbye cruel world!!'. + self + assert: + clone readStream contents + equals: (original readStream contents , 'Goodbye cruel world!!') ] +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test070LargeFileWrite + | fs root large original name new written | + fs := self openRawBig. + root := fs root. + large := root files detect: [:file | file name asLowercase = 'moreth~2'] ifNone: [self assert: false]. + original := large readStream contents trimmed. + name := 'new.st'. + self assert: ( root files noneSatisfy: [:file | file name asLowercase = name] ). + new := root newFileNamed: name. + + new readWriteStream nextPutAll: original. + written := (root fileNamed: name) readStream contents. + self assert: written size > fs bytesPerCluster; + assert: (written first: 13) equals: '1234567890abc'; + assert: (written last: 13) equals: '1234567890abc'; + assert: written equals: original. + + +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test080CompareToStandardFileStream + | fs fatChanges fat32TestStream standardTestStream | + fs := self openRawBig. + fatChanges := fs root readOnlyFileNamed: (fs pureFAT32FilenameFor: 'SqueakNOS.changes'). + fat32TestStream := fatChanges readStream. + standardTestStream := 'testdata/SqueakNOS.changes' asFileReference readStream. + self assert: fat32TestStream size = standardTestStream size. + self assert: (fat32TestStream next: 1000) = (standardTestStream next: 1000). + fat32TestStream position: 10000. + standardTestStream position: 10000. + self assert: (fat32TestStream basicUpTo: $!!) = (standardTestStream basicUpTo: $!!). + fat32TestStream position: fat32TestStream size - 500. + standardTestStream position: standardTestStream size - 500. + self assert: fat32TestStream upToEnd = standardTestStream upToEnd +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test090WriteAtEndOfChanges + | fs stream changes readOnlyStream contents | + fs := self openRawBig. + changes := fs root readOnlyFileNamed: (fs pureFAT32FilenameFor: 'SqueakNOS.changes'). + stream := changes readWriteStream. + stream position: stream size. + stream nextPutAll: 'Test content'. + readOnlyStream := changes readStream. + readOnlyStream position: readOnlyStream size - 12. + contents := readOnlyStream next: 12. + self assert: contents = 'Test content' +! ! + +!ExampleFAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test100MethodSources +" | image sources | + image := SmalltalkImage current. + [image openSourceFilesForSqueakNos. + sources := SmalltalkImage methodDictionary at: #argumentAt:. + self + assert: (sources getSource string includesSubString: 'argumentAt: i')] + ensure: [image openSourceFiles]" +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExampleFAT32FileSystemTest class' category: 'SqueakNOS-Filesystems-FAT32'! +ExampleFAT32FileSystemTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/FileSystems/FAT32/FAT32BootRecord.Class.st b/modules/NOS/FileSystems/FAT32/FAT32BootRecord.Class.st new file mode 100644 index 00000000..1171da5b --- /dev/null +++ b/modules/NOS/FileSystems/FAT32/FAT32BootRecord.Class.st @@ -0,0 +1,285 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #FAT32BootRecord category: 'SqueakNOS-Filesystems-FAT32'! +Object subclass: #FAT32BootRecord + instanceVariableNames: 'bytes' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems-FAT32'! +!FAT32BootRecord commentStamp: '' prior: 0! + +A FAT32BootRecord contains the description of a fat32 partition. +! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +bootRecordSignature + ^bytes unsignedShortAt: 16r1FF. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +bootRecordSignature: anInteger + ^ bytes unsignedShortAt: 16r1FF put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes + "Answer the value of bytes" + + ^ bytes +! ! + +!FAT32BootRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: anObject + "Set the value of bytes" + + bytes := anObject +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytesPerSector + ^bytes unsignedShortAt: 16r0C. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytesPerSector: anInteger + ^ bytes unsignedShortAt: 16r0C put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +clusterNumberOfStartOfRootDir + ^bytes unsignedLongAt: 16r2D. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +clusterNumberOfStartOfRootDir: anInteger + ^ bytes unsignedLongAt: 16r2D put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +executableCode: aString + Transcript show: 'complete this method (executableCode:)' +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +extendedSignature + ^bytes unsignedByteAt: 16r43. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +extendedSignature: anInteger + ^ bytes unsignedByteAt: 16r43 put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +fatName + ^(bytes copyFrom: 16r53 to: 16r5A) asString. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +fatName: aString + bytes replaceFrom: 16r53 to: 16r5A with: aString +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +flags + ^bytes unsignedShortAt: 16r29. +! ! + +!FAT32BootRecord methodsFor: 'accessing structure variables' stamp: 'KenD 28/Jun/2026 13:32:25'! +flags: anInteger + ^ bytes unsignedShortAt: 16r29 put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initializeWithDefaultValues + self + bytesPerSector: 512; + sectorsPerCluster: 1; + reservedSectors: 16r20; + numberOfCopiesOfFAT: 2; + mediaDescriptor: 16rF8; + sectorsPerTrack: 16r20; + numberOfHeads: 64; + numberOfHiddenSectors: 16r20; + sectorsPerFAT: 16r020C; + flags: 0; + versionOfFAT32Drive: 0; + clusterNumberOfStartOfRootDir: 2; + sectorNumberOfFSInformationSector: 1; + logicalDriveNumberOfPartition: 16r80; + extendedSignature: 16r29; + volumeNameOfPartition: 'NO NAME '; + fatName: 'FAT32 '; + executableCode: '0'; + bootRecordSignature: 16rAA55 +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +logicalDriveNumberOfPartition + ^bytes unsignedByteAt: 16r41. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +logicalDriveNumberOfPartition: anInteger + ^ bytes unsignedByteAt: 16r41 put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +mediaDescriptor + ^bytes unsignedByteAt: 16r16. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +mediaDescriptor: anInteger + ^ bytes unsignedByteAt: 16r16 put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfCopiesOfFAT + ^bytes unsignedByteAt: 16r11. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfCopiesOfFAT: anInteger + ^ bytes unsignedByteAt: 16r11 put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfHeads + ^bytes unsignedShortAt: 16r1B. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfHeads: anInteger + ^ bytes unsignedShortAt: 16r1B put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfHiddenSectors + ^bytes unsignedLongAt: 16r1D. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfHiddenSectors: anInteger + ^ bytes unsignedLongAt: 16r1D put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfSectorsInPartition + ^bytes unsignedLongAt: 16r21. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfSectorsInPartition: anInteger + ^ bytes unsignedLongAt: 16r21 put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: out + + out nextPutAll: 'Boot sector named '; << self volumeNameOfPartition; cr. + out nextPutAll: 'Bytes per sector: '; << self bytesPerSector; cr. + out nextPutAll: 'Sectors per cluster: '; << self sectorsPerCluster; cr. + out nextPutAll: 'Cluster number of start of root dir: '; << self clusterNumberOfStartOfRootDir; cr. + out nextPutAll: 'Sectors per FAT: '; << self sectorsPerFAT; cr. + out nextPutAll: 'Sectors per track: '; << self sectorsPerTrack; cr. + out nextPutAll: 'Number of sectors in partition: '; << self numberOfSectorsInPartition; cr. + out nextPutAll: 'Number of copies of FAT: '; << self numberOfCopiesOfFAT; cr. + out nextPutAll: 'Reserved sectors: '; << self reservedSectors. + +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +reservedSectors + ^bytes unsignedShortAt: 16r0F. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +reservedSectors: anInteger + ^ bytes unsignedShortAt: 16r0F put: anInteger + +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +sectorNumberOfFSInformationSector + ^bytes unsignedShortAt: 16r31. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +sectorNumberOfFSInformationSector: anInteger + ^ bytes unsignedShortAt: 16r31 put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +sectorsPerCluster + ^bytes unsignedByteAt: 16rE. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +sectorsPerCluster: anInteger + ^ bytes unsignedByteAt: 16rE put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +sectorsPerFAT + ^bytes unsignedLongAt: 16r25. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +sectorsPerFAT: anInteger + ^ bytes unsignedLongAt: 16r25 put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +sectorsPerTrack + ^bytes unsignedShortAt: 16r19. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +sectorsPerTrack: anInteger + ^ bytes unsignedShortAt: 16r19 put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +serialNumberOfPartition + ^bytes unsignedLongAt: 16r44. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +verifySignature + self bootRecordSignature = 16rAA55 + ifFalse: [ self error: 'This does not look as a FAT32 partition' ] +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +versionOfFAT32Drive + ^bytes unsignedShortAt: 16r2B. +! ! + +!FAT32BootRecord methodsFor: 'versions' stamp: 'KenD 28/Jun/2026 13:32:25'! +versionOfFAT32Drive: anInteger + ^ bytes unsignedShortAt: 16r2B put: anInteger +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +volumeNameOfPartition + ^(bytes copyFrom: 16r48 to: 16r52) asString. +! ! + +!FAT32BootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +volumeNameOfPartition: aString + bytes replaceFrom: 16r48 to: 16r52 with: aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FAT32BootRecord class' category: 'SqueakNOS-Filesystems-FAT32'! +FAT32BootRecord class + instanceVariableNames: ''! + +!FAT32BootRecord class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray + ^self new bytes: aByteArray. +! ! + + diff --git a/modules/NOS/FileSystems/FAT32/FAT32Cluster.Class.st b/modules/NOS/FileSystems/FAT32/FAT32Cluster.Class.st new file mode 100644 index 00000000..ff95402b --- /dev/null +++ b/modules/NOS/FileSystems/FAT32/FAT32Cluster.Class.st @@ -0,0 +1,225 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #FAT32Cluster category: 'SqueakNOS-Filesystems-FAT32'! +Object subclass: #FAT32Cluster + instanceVariableNames: 'contents' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems-FAT32'! +!FAT32Cluster methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +add: aFAT32ClusterRecord at: anIndex + | start bytes | + start := self recordSize * (anIndex - 1). + bytes := aFAT32ClusterRecord contents. + contents replaceFrom: start to: start + bytes size - 1 with: bytes startingAt: 1 +! ! + +!FAT32Cluster methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +addEndOfDirectoryRecord + | index record | + index := self firstFreeRecordIndex. + record := self recordAt: index. + record beEndOfDirectory. +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +addFirstClusterToFileNamed: aString cluster: aNumber + | index record | + index := self indexOfRecordNamed: aString. + record := self recordAt: index. + record firstCluster: aNumber +! ! + +!FAT32Cluster methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +addRecordNamed: aString firstCluster: aNumber + | index record addEndOfDirectoryRecord | + index := self firstFreeRecordIndex. + addEndOfDirectoryRecord := (index = 1 or: [(self recordAt: index) isEndOfDirectory and: [(index = self lastIndex) not]]). + record := self recordAt: index. + record name: aString; firstCluster: aNumber. + addEndOfDirectoryRecord ifTrue: [self addEndOfDirectoryRecord]. + ^record + +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +allRecords + ^ (1 to: self lastIndex) collect: [ :i | self recordAt: i ] +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: index count: amount + ^ contents segmentFrom: index to: index + amount - 1 +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aNumber + contents position: 0. + ^contents next: aNumber +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aNumber startingAt: anotherNumber + contents position: anotherNumber. + ^contents next: aNumber +! ! + +!FAT32Cluster methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents + ^ contents +! ! + +!FAT32Cluster methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: bytes + contents := bytes +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +directoryRecords + ^self records select: [:record | (record isUnused not and: [record isVFat not]) and: [record isDirectory]] +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +fileRecords + ^self records select: [:record | (record isUnused not and: [record isVFat not]) and: [record isFile]] +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstFreeRecordIndex + self allRecords withIndexDo: [:record :index | (record isUnused or: [record isEndOfDirectory]) ifTrue: [^index]]. + self error: 'aaaa' +! ! + +!FAT32Cluster methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstIndex + ^1 +! ! + +!FAT32Cluster methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hasFreeRecords + | records | + records := self allRecords. + ^(records anySatisfy: [:record | record isUnused]) or: [records anySatisfy: [:record | record isEndOfDirectory]]. +! ! + +!FAT32Cluster methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hasRecord: id + ^self allRecords anySatisfy: [:record | (record firstCluster = id)]. + +! ! + +!FAT32Cluster methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hasRecordNamed: aString + ^self allRecords anySatisfy: [:record | (record name asLowercase = aString asLowercase)]. + +! ! + +!FAT32Cluster methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +identifierOfRecordNamed: aString + self records withIndexDo: [:record :index | (record name asLowercase = aString asLowercase) ifTrue: [^record firstCluster]]. + self error: 'Not found' +! ! + +!FAT32Cluster methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +indexOfRecord: id + self records withIndexDo: [:record :index | (record firstCluster = id) ifTrue: [^index]]. + self error: 'Not found' +! ! + +!FAT32Cluster methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +indexOfRecordNamed: aString + self records withIndexDo: [:record :index | (record name asLowercase = aString asLowercase) ifTrue: [^index]]. + self error: 'Not found' +! ! + +!FAT32Cluster methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +initializeUnused + self allRecords do: [:record | record free] +! ! + +!FAT32Cluster methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +lastIndex + ^self size // self recordSize +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +record: id + | index | + index := self indexOfRecord: id. + ^self recordAt: index +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +recordAt: index + | size start bytes | + size := self recordSize. + start := (index - 1) * size. + bytes := contents segmentFrom: start + 1 size: size. + ^ FAT32ClusterRecord contents: bytes +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +recordNamed: aString + | index | + index := self indexOfRecordNamed: aString. + ^self recordAt: index +! ! + +!FAT32Cluster methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +recordSize + ^32 +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +records + ^self allRecords reject: [:record | record isUnused or: [record isEndOfDirectory]] +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +removeRecord: id + | record | + record := self record: id. + record free + +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +removeRecordNamed: aString + | record | + record := self recordNamed: aString. + record free + +! ! + +!FAT32Cluster methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^contents size +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +updateSizeOfFileNamed: aString with: aNumber + | index record | + index := self indexOfRecordNamed: aString. + record := self recordAt: index. + record size: aNumber +! ! + +!FAT32Cluster methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +writeFrom: start with: stringOrByteArray startingAt: otherStart count: count + contents + replaceFrom: start to: start + count - 1 with: stringOrByteArray startingAt: otherStart. + ^ count +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FAT32Cluster class' category: 'SqueakNOS-Filesystems-FAT32'! +FAT32Cluster class + instanceVariableNames: ''! + +!FAT32Cluster class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: aStream + ^self new contents: aStream. +! ! + + diff --git a/modules/NOS/FileSystems/FAT32/FAT32ClusterRecord.Class.st b/modules/NOS/FileSystems/FAT32/FAT32ClusterRecord.Class.st new file mode 100644 index 00000000..4a981f1b --- /dev/null +++ b/modules/NOS/FileSystems/FAT32/FAT32ClusterRecord.Class.st @@ -0,0 +1,186 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #FAT32ClusterRecord category: 'SqueakNOS-Filesystems-FAT32'! +Object subclass: #FAT32ClusterRecord + instanceVariableNames: 'contents' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems-FAT32'! +!FAT32ClusterRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +attrib + ^ contents byteAtOffset: 16r0B +! ! + +!FAT32ClusterRecord methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +beEndOfDirectory + contents byteAt: 1 put: 0 +! ! + +!FAT32ClusterRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents + ^ contents +! ! + +!FAT32ClusterRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: bytes + contents := bytes +! ! + +!FAT32ClusterRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstCluster + | hi lo | + hi := contents unsignedShortAtOffset: 16r14. + lo := contents unsignedShortAtOffset: 16r1A. + ^ lo + (hi bitShift: 16) +! ! + +!FAT32ClusterRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstCluster: aNumber + | hi lo | + lo := aNumber bitAnd: 16rFFFF. + hi := (aNumber bitShift: -16) bitAnd: 16rFFFF. + contents + unsignedShortAtOffset: 16r14 put: hi; + unsignedShortAtOffset: 16r1A put: lo +! ! + +!FAT32ClusterRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +free + ^ contents at: 1 put: self unusedByte +! ! + +!FAT32ClusterRecord methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isDirectory + ^(self attrib bitAnd: 16) = 16 + +! ! + +!FAT32ClusterRecord methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isEndOfDirectory + ^(contents byteAt: 1) isZero + +! ! + +!FAT32ClusterRecord methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isFile + ^(self attrib bitAnd: 16) = 0 +! ! + +!FAT32ClusterRecord methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isInternal + ^self isDirectory and: [self name = '.' or: [self name = '..']] + +! ! + +!FAT32ClusterRecord methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isUnused + ^(contents byteAt: 1) = 16rE5 + +! ! + +!FAT32ClusterRecord methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isVFat + ^(self attrib bitAnd: 15) = 15 + +! ! + +!FAT32ClusterRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + | bytes name extension | + bytes := contents asByteArray. + name := (String new: 8) + replaceFrom: 1 + to: 8 + with: bytes + startingAt: 1; + trimmed. + extension := (String new: 3) + replaceFrom: 1 + to: 3 + with: bytes + startingAt: 9; + trimmed. + extension notEmpty + ifTrue: [ extension := '.' , extension ]. + ^ name , extension +! ! + +!FAT32ClusterRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name: aString + aString size = 11 ifFalse: [self error: 'The string is not in a suitable format']. + contents replaceFrom: 1 to: 11 with: aString asByteArray startingAt: 1 + + +! ! + +!FAT32ClusterRecord methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + ^aStream nextPutAll: self name +! ! + +!FAT32ClusterRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^contents unsignedLongAtOffset: 16r1C + +! ! + +!FAT32ClusterRecord methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size: value + ^ contents unsignedLongAtOffset: 16r1C put: value +! ! + +!FAT32ClusterRecord methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:32:25'! +unusedByte + ^16rE5 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FAT32ClusterRecord class' category: 'SqueakNOS-Filesystems-FAT32'! +FAT32ClusterRecord class + instanceVariableNames: ''! + +!FAT32ClusterRecord class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: bytes + ^ self new contents: bytes +! ! + +!FAT32ClusterRecord class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +endOfDirectory + ^self contents: (self streamForEndOfDirectory) + +! ! + +!FAT32ClusterRecord class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +named: aString firstCluster: aNumber + ^(self raw) name: aString; firstCluster: aNumber. + +! ! + +!FAT32ClusterRecord class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +raw + ^self contents: (self streamForNewRecord) + +! ! + +!FAT32ClusterRecord class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^32 +! ! + +!FAT32ClusterRecord class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +streamForEndOfDirectory + | contents | + contents := ByteArray new: self size withAll: 0. + ^ReadWriteStream with: contents +! ! + +!FAT32ClusterRecord class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +streamForNewRecord + | contents | + contents := ByteArray new: self size withAll: 0. + ^ReadWriteStream with: contents. + +! ! + + diff --git a/modules/NOS/FileSystems/FAT32/FAT32FileAllocationTable.Class.st b/modules/NOS/FileSystems/FAT32/FAT32FileAllocationTable.Class.st new file mode 100644 index 00000000..f7c2fbd3 --- /dev/null +++ b/modules/NOS/FileSystems/FAT32/FAT32FileAllocationTable.Class.st @@ -0,0 +1,225 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #FAT32FileAllocationTable category: 'SqueakNOS-Filesystems-FAT32'! +Object subclass: #FAT32FileAllocationTable + instanceVariableNames: 'chains contents' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems-FAT32'! +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +addCluster: aNumber to: chainId + | chain last | + chainId > 0 ifTrue: [ + chain := self chainFor: chainId. + last := chain last. + chain add: aNumber. + self at: last put: aNumber]. + self at: aNumber put: self clusterChainEndValue + +! ! + +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +addClusterTo: chainStart + | last index chain | + last := chainStart > 0 ifTrue: + [(self clustersChainFor: chainStart) last] + ifFalse: + [0]. + index := self firstFreeClusterSince: last. + "Transcript show: 'Adding cluster: ', index printString, 'to: ', chainStart printString, Character cr." + self addCluster: index to: chainStart. + ^index +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: index + "fat indexes are 0-based" + ^ contents unsignedLongAt: index * 4 + 1 +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: index put: value + "fat indexes are 0-based" + + contents unsignedLongAt: index * 4 + 1 put: value +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +cache: aNumber with: anOrderedCollection + chains at: aNumber put: anOrderedCollection +! ! + +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +cachedChain: aNumber preferredSize: aPreferredSize + ^(self hasCached: aNumber) + ifTrue: [ ^self chainFor: aNumber ] + ifFalse: [ | chain | + chain := self internalClusterChainFor: aNumber preferredSize: aPreferredSize. + self cache: aNumber with: chain. + ^chain ] + +! ! + +!FAT32FileAllocationTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +chainFor: aNumber + ^chains at: aNumber +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +clusterChainEndValue + ^16r0FFFFFF8. + +! ! + +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +clustersChainFor: aNumber + ^self clustersChainFor: aNumber preferredSize: 0 +! ! + +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +clustersChainFor: aNumber preferredSize: aPreferredSize + ^(self cachedChain: aNumber preferredSize: aPreferredSize) copy. + +! ! + +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +clustersChainNoCopyFor: aClusterNumber preferredSize: aSize + ^(self cachedChain: aClusterNumber preferredSize: aSize). + +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: bytes + contents := bytes +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +countOfClusters + ^contents size // self recordSize +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +finishClustersChainValue + | bytes | + bytes := (ByteArray new: 4). + bytes unsignedLongAt: 1 put: 16r0FFFFFFF. + ^bytes +! ! + +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstFreeClusterSince: aNumber + | current limit entry | + current := aNumber max: 2. + limit := aNumber - 1. + [ + entry := self at: current. + entry isZero ] whileFalse: [ + current = limit ifTrue: [ self error: 'No more free space on filesystem' ]. + current := current + 1. + current = self countOfClusters ifTrue: [ current := 2 ]. + ]. + ^current +! ! + +!FAT32FileAllocationTable methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hasCached: aNumber + ^chains includesKey: aNumber +! ! + +!FAT32FileAllocationTable methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + chains := Dictionary new. +! ! + +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +internalClusterChainFor: chainId preferredSize: aPreferredSize + | chain next end | + next := chainId. + chain := OrderedCollection new: aPreferredSize. + end := self clusterChainEndValue. + [ next := next bitAnd: 16r0FFFFFFF. + next < end ] + whileTrue: [ next = 0 + ifTrue: [ self error: 'broken FAT: found empty cluster while following cluster chain' ]. + chain add: next. + next := self at: next ]. + ^ chain +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextClusterFor: index + self setPositionTo: index. + ^self nextRecord unsignedLongAt: 1. +! ! + +!FAT32FileAllocationTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextRecord + ^contents next: self recordSize +! ! + +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +point: aFatClusterNumber to: anotherFatClusterNumber + "Alter the FAT so that it's cluster number aFatClusterNumber points to anotherFatClusterNumber" + | bytes | + self setPositionTo: aFatClusterNumber. + bytes := (ByteArray new: 4). + bytes unsignedLongAt: 1 put: anotherFatClusterNumber. + contents nextPutAll: bytes. +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +recordSize + ^4 +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +removeChainOf: id + | chain | + chain := self clustersChainFor: id. + chain do: [:index | self at: index put: 0] +! ! + +!FAT32FileAllocationTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +resetAllEntries + | size | + size := self recordSize. + self + at: 1 put: 16r0FFFFFF8; + at: 2 put: 16r0FFFFFFF +! ! + +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +setPositionTo: aNumber + contents position: aNumber * self recordSize. + +! ! + +!FAT32FileAllocationTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +shrinkClusterChainOf: aNumber to: length + | chain size toRemove last | + chain := self clustersChainFor: aNumber. + size := chain size. + size > length ifFalse: [^self]. + toRemove := length - size. + last := chain at: length. + self at: last put: self clusterChainEndValue. + chain := chain last: toRemove. + chain do: [:index | self at: index put: 0]. + + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FAT32FileAllocationTable class' category: 'SqueakNOS-Filesystems-FAT32'! +FAT32FileAllocationTable class + instanceVariableNames: ''! + +!FAT32FileAllocationTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: aStream + ^self new contents: aStream. +! ! + + +FAT32FileAllocationTable initialize! + diff --git a/modules/NOS/FileSystems/FAT32/FAT32FileSystem.Class.st b/modules/NOS/FileSystems/FAT32/FAT32FileSystem.Class.st new file mode 100644 index 00000000..01bc061c --- /dev/null +++ b/modules/NOS/FileSystems/FAT32/FAT32FileSystem.Class.st @@ -0,0 +1,544 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #FAT32FileSystem category: 'SqueakNOS-Filesystems-FAT32'! +Object subclass: #FAT32FileSystem + instanceVariableNames: 'contents bootRecordCache fat clusterContents stream offsetToPartition flushProcess' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems-FAT32'! +!FAT32FileSystem commentStamp: '' prior: 0! + +A FAT32FileSystem is the one who interacts with a FAT32 partition. It has a stream pointing to a disk +and the offset to the start point of one of its' partitions. + +Instance Variables + offsetToPartition: offset to partition + stream: a stream pointing to a disk. + +! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +addClusterTo: aFilesystemContent + | index id | + id := aFilesystemContent identifier. + index := fat addClusterTo: id. + aFilesystemContent isDirectory ifTrue: [(self clusterAt: index) initializeUnused]. + ^index +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +addClustersTo: aFilesystemContent count: aNumber + | clusters | + Transcript show: 'adding ', aNumber printString, ' clusters to file.', Character cr asString. + clusters := OrderedCollection new. + aNumber timesRepeat: [clusters add: (self addClusterTo: aFilesystemContent)]. + ^clusters +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +addFirstClusterTo: aFilesystemContent + | index cluster | + index := self addClusterTo: aFilesystemContent. + aFilesystemContent identifier: index. + cluster := self clusterForFileNamed: aFilesystemContent name onDirectory: aFilesystemContent directory. + cluster addFirstClusterToFileNamed: aFilesystemContent name cluster: index + +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +adjacentClustersListFrom: clusters do: aBlock + | clusterStartNumber numberOfClusters | + clusters size = 0 ifTrue: [^self]. + clusterStartNumber := clusters first. + numberOfClusters := 1. + 2 to: clusters size do: [ :i | | cluster | + cluster := clusters at: i. + (clusterStartNumber + numberOfClusters = cluster) + ifTrue: [ numberOfClusters := numberOfClusters + 1] + ifFalse: [ aBlock value: clusterStartNumber value: numberOfClusters. + numberOfClusters := 1. + clusterStartNumber := cluster] + ]. + aBlock value: clusterStartNumber value: numberOfClusters. + +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +as83Format: aString + | index name extension | + index := aString findFirst: [:char | char = $.]. + name := index > 7 ifTrue: [aString first: 8] ifFalse: [(aString first: index - 1) , ((String new: 8 - index + 1) atAllPut: $ ) ]. + extension := aString size - index > 3 ifTrue: [aString copyFrom: index + 1 to: index + 3] ifFalse: [(aString copyFrom: index + 1 to: aString size) , ((String new: 3 - (aString size - index)) atAllPut: $ ) ]. + ^name , extension. +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bootRecord + ^ bootRecordCache ifNil: [ bootRecordCache := FAT32BootRecord bytes: (contents copyFrom: 1 to: 512) ] +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytesPerCluster + ^self sectorsPerCluster * self bytesPerSector +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytesPerFAT + ^self sectorsPerFAT * self bytesPerSector +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytesPerSector + ^self bootRecord bytesPerSector +! ! + +!FAT32FileSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +cleanExtraSpace: id + | clusters | + clusters := self clustersNeededFor: id size. + fat shrinkClusterChainOf: id identifier to: clusters +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +clusterAt: index + | start bytes | + start := self positionOfCluster: index. + + bytes := clusterContents segmentFrom: start size: self bytesPerCluster. + ^ FAT32Cluster contents: bytes +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +clusterForFile: aFile onDirectory: aDirectory + | chain | + chain := self clustersChainFor: aDirectory. + chain do: [:number | | cluster | + cluster := self clusterAt: number. + (cluster hasRecord: aFile identifier) ifTrue: [^cluster]]. + self error:'cluster not found!!' +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +clusterForFileNamed: aString onDirectory: aDirectory + | chain | + chain := self clustersChainFor: aDirectory. + chain do: [:number | | cluster | + cluster := self clusterAt: number. + (cluster hasRecordNamed: aString) ifTrue: [^cluster]]. + self error:'cluster not found!!' +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +clusterNumberWithFreeRecordsFor: aDirectory + | chain | + chain := self clustersChainFor: aDirectory. + ^chain + detect: [:number | (self clusterAt: number) hasFreeRecords] + ifNone: [self addClusterTo: aDirectory] +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +clusterWithFileNamed: aString for: aDirectory + | chain | + chain := self clustersChainFor: aDirectory. + ^chain detect: [:number | (self clusterAt: number) hasRecordNamed: aString] +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +clustersBeginOffset + ^self fatBeginOffset + (self numberOfCopiesOfFAT * self bytesPerFAT) +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +clustersChainFor: aFileSystemContent + | clusters count | + count := aFileSystemContent isFile ifTrue: [ + (aFileSystemContent size / self bytesPerCluster) ceiling. + ] ifFalse: [0]. + ^fat clustersChainFor: aFileSystemContent identifier preferredSize: count. + +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +clustersChainNoCopyFor: aFileSystemContent + | count | + count := aFileSystemContent isFile + ifTrue: [ (aFileSystemContent size / self bytesPerCluster) ceiling ] + ifFalse: [ 0 ]. + ^ fat clustersChainNoCopyFor: aFileSystemContent identifier preferredSize: count +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +clustersCount + ^(bootRecordCache numberOfSectorsInPartition - (self numberOfCopiesOfFAT * self bytesPerFAT / self bytesPerSector + self reservedSectors)) / self sectorsPerCluster. +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +clustersNeededFor: aNumber + ^(aNumber / self bytesPerCluster) ceiling +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: bytes + contents:= bytes +! ! + +!FAT32FileSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +contentsFor: aFile startingAt: position count: count + | bytesPerCluster size clusterOffset needed clusters | + + bytesPerCluster := self bytesPerCluster. + aFile identifier > 0 ifFalse: [^ByteArray new]. + size := count min: aFile size. + clusterOffset := position \\ bytesPerCluster. + needed := (size + clusterOffset / bytesPerCluster) ceiling. + clusters := self clustersChainFor: aFile. + clusters removeFirst: position // bytesPerCluster. + clusters size >= needed ifTrue: [clusters removeLast: clusters size - needed]. + ^self readFromClusters: clusters startingAt: clusterOffset count: size. + +! ! + +!FAT32FileSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +createFileNamed: aString on: aDirectory + | cluster record number name | + name := aString size > 11 ifTrue: [self pureFAT32FilenameFor: aString] + ifFalse: [aString]. + number := self clusterNumberWithFreeRecordsFor: aDirectory. + cluster := self clusterAt: number. + contents := fat firstFreeClusterSince: 2. + fat addCluster: contents to: 0. + record := cluster addRecordNamed: (self as83Format: name) firstCluster: contents. + ^NOSFile named: record name identifier: record firstCluster filesystem: self directory: aDirectory size: record size +! ! + +!FAT32FileSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +directoriesFor: aDirectory + | cluster directories clusters subdirs| + directories := OrderedCollection new. + clusters := self clustersChainFor: aDirectory. + clusters do: [ :aNumber | + cluster := self clusterAt: aNumber. + subdirs := (cluster directoryRecords + select: [:record | record isInternal not] + thenCollect: [:record | NOSDirectory + named: record name + identifier: record firstCluster + filesystem: self + directory: aDirectory]). + directories addAll: subdirs + ]. + ^directories +! ! + +!FAT32FileSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +directoryNamed: aString + | components current | + components := aString findTokens: $/. + components isEmpty ifTrue: [^nil]. + current := self root. + components do: [ :name | + current := current directories detect: [:directory | directory name asLowercase = name] ifNone: [^nil]. + ]. + ^current +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +fatBeginOffset + ^self reservedSectors * self bytesPerSector + + +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +fatFinishClustersChainValue + ^fat finishClustersChainValue +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +fatOffset + ^self reservedSectors * self bytesPerSector + + +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fatRecordSize + ^fat recordSize +! ! + +!FAT32FileSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +filesFor: aDirectory + | cluster files clusters subfiles | + files := OrderedCollection new. + clusters := self clustersChainFor: aDirectory. + clusters + do: [ :aNumber | + cluster := self clusterAt: aNumber. + subfiles := cluster fileRecords + collect: [ :record | + NOSFile + named: record name + identifier: record firstCluster + filesystem: self + directory: aDirectory + size: record size ]. + files addAll: subfiles ]. + ^ files +! ! + +!FAT32FileSystem methodsFor: 'flushing' stamp: 'KenD 28/Jun/2026 13:32:25'! +flushProcess + ^ [ (Delay forSeconds: 10) wait. + fat flushChanges. + self flushClusterChanges ] fork +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +format + | sectors boot | + sectors := contents size / 512. + boot := FAT32BootRecord bytes: (contents segmentFrom: 1 to: 512). + boot initializeWithDefaultValues; numberOfSectorsInPartition: sectors. + self open. + fat resetAllEntries +! ! + +!FAT32FileSystem methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize +! ! + +!FAT32FileSystem methodsFor: 'formatting' stamp: 'KenD 28/Jun/2026 13:32:25'! +nameFormat: aString + ^self pureFAT32FilenameFor: aString +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfCopiesOfFAT + ^self bootRecord numberOfCopiesOfFAT +! ! + +!FAT32FileSystem methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +open + | fatContents fatEnd clusterStart | + self bootRecord verifySignature. + fatEnd := self fatOffset + (self clustersCount * 4). + fatContents := contents segmentFrom: self fatOffset + 1 to: fatEnd - 1. + fat := FAT32FileAllocationTable contents: fatContents. + clusterStart := self clustersBeginOffset - (self bytesPerCluster * 2) + 1. + clusterContents := contents segmentFrom: clusterStart to: contents size - 1 +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +positionOfCluster: index + "cluster numbers are 0-based" + ^index * self bytesPerCluster + 1 +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: out + "Answer the value of stream" + + out nextPutAll: 'FAT32FileSystem'; cr; + nextPutAll: 'Begin of FAT: ', self fatBeginOffset hex; cr; + nextPutAll: 'Begin of data clusters: ', self clustersBeginOffset hex; cr; cr; + nextPutAll: bootRecordCache printString; cr; cr; + nextPutAll: self root printString. + +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printStringOf: aDirectory + | cluster clusters out | + + out := ReadWriteStream on: ''. + clusters := self clustersChainFor: aDirectory. + clusters do: [ :aNumber | + cluster := self clusterAt: aNumber. + cluster fileRecords do: [ :record | + out nextPutAll: 'File: ', record name; + nextPutAll: ', first cluster: '; << record firstCluster; + nextPutAll: ', size: '; << record size; nextPut: Character cr ]. + ]. + + ^out contents. +! ! + +!FAT32FileSystem methodsFor: 'formatting' stamp: 'KenD 28/Jun/2026 13:32:25'! +pureFAT32FilenameFor: aFileName + | path basename extension finalName | + path := aFileName asFileReference path. + basename := path base. + extension := path extension. + (basename size > self class basenameMaxSize or: [extension size > self class extensionMaxSize]) ifTrue: [ + basename := (basename first: self class basenameTruncationIndex) , '~1' + ]. + extension := extension copyFrom: 1 to: (extension size min: self class extensionMaxSize). + finalName := (extension size > 0) ifTrue: [ basename , '.' , extension ] ifFalse: [ basename ]. + ^ (String streamContents: [:str | (path parent / finalName) asFileReference gtDisplayOn: str]) + +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +readFromClusters: clusters startingAt: offset count: count + | startOffset contentsIndex cluster bytes result qty remaining | + result := ByteArray new: count. + startOffset := offset. + contentsIndex := 1. + remaining := count. + clusters do: [ :clusterNumber | + cluster := self clusterAt: clusterNumber. + qty := cluster size - startOffset min: remaining. + bytes := cluster at: startOffset + 1 count: qty. + result replaceFrom: contentsIndex to: contentsIndex + qty - 1 with: bytes. + startOffset := 0. + remaining := remaining - qty. + contentsIndex := contentsIndex + qty]. + ^result + + +! ! + +!FAT32FileSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +removeFileNamed: aString on: aDirectory + | cluster number id name | + name := self pureFAT32FilenameFor: aString. + number := self clusterWithFileNamed: name for: aDirectory. + cluster := self clusterAt: number. + id := cluster identifierOfRecordNamed: name. + cluster removeRecordNamed: name. + id > 0 ifTrue: [fat removeChainOf: id] + +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +reservedSectors + ^self bootRecord reservedSectors +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +root + ^NOSDirectory identifier: self bootRecord clusterNumberOfStartOfRootDir filesystem: self +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +sectorsPerCluster + ^self bootRecord sectorsPerCluster +! ! + +!FAT32FileSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +sectorsPerFAT + ^self bootRecord sectorsPerFAT +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +startOfClusterSectors + ^(self numberOfCopiesOfFAT * self bytesPerFAT) / self bytesPerSector + self reservedSectors. +! ! + +!FAT32FileSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +truncateClusterChainOf: aFile newSize: aNumber + | clusterSize clusters needed | + clusterSize := self bytesPerCluster. + clusters := self clustersChainFor: aFile. + needed := (aNumber / clusterSize) ceiling. + + needed <= clusters size ifTrue: [clusters removeLast: clusters size - needed] + +! ! + +!FAT32FileSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +updateSizeOf: aFile with: aNumber + | cluster | + self truncateClusterChainOf: aFile newSize: aNumber. + cluster := self clusterForFile: aFile onDirectory: aFile directory. + cluster updateSizeOfFileNamed: aFile name with: aNumber. + aFile size: aNumber +! ! + +!FAT32FileSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +writeClusters: clusters startingAt: start with: bytes startingAt: bytesStart count: count + | written offset toWrite | + written := 0. + offset := start - 1. + self + adjacentClustersListFrom: clusters + do: [ :clusterStartNumber :numberOfClusters | + | cluster index | + toWrite := numberOfClusters * self bytesPerCluster - offset min: count - written. + index := self positionOfCluster: clusterStartNumber. + clusterContents + replaceFrom: index + offset + to: index + offset + toWrite - 1 + with: bytes + startingAt: bytesStart + written. + offset := 0. + written := written + toWrite ]. + ^ written +! ! + +!FAT32FileSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +writeOn: aFile startingAt: aFileOffset contents: bytes startingAt: bytesStart count: count + "notice: aFileOffset is zero indexed, anotherNumber is not" + | helper firstIndex lastIndex clusters | + + helper := BlockArithmetic new size: self bytesPerCluster. + firstIndex := helper blockNumberOf: aFileOffset + 1. + lastIndex := helper blockNumberOf: aFileOffset + count. + + aFile identifier = 0 ifTrue: [self addFirstClusterTo: aFile]. + + clusters := self clustersChainNoCopyFor: aFile. + lastIndex > clusters size ifTrue: [ self addClustersTo: aFile count: lastIndex - clusters size]. + + ^self writeClusters: (clusters copyFrom: firstIndex to: lastIndex) + startingAt: (helper positionInBlockOf: aFileOffset + 1) + with: bytes asByteArray startingAt: bytesStart count: count. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FAT32FileSystem class' category: 'SqueakNOS-Filesystems-FAT32'! +FAT32FileSystem class + instanceVariableNames: ''! + +!FAT32FileSystem class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:32:25'! +basenameMaxSize + ^8 +! ! + +!FAT32FileSystem class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:32:25'! +basenameTruncationIndex + ^self basenameMaxSize - 2 +! ! + +!FAT32FileSystem class methodsFor: 'constants' stamp: 'KenD 28/Jun/2026 13:32:25'! +extensionMaxSize + ^3 +! ! + +!FAT32FileSystem class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +join: path to: finalName + ^((path = '') ifFalse: [path, FileDirectory slash] ifTrue: ['']), finalName. +! ! + +!FAT32FileSystem class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +of: aDiskStream partition: aNumber readOnly: beReadOnly + "We asume sector size of 512 to make things easier for now." + aDiskStream binary. "With this we make #next: return ByteArrays and no ByteStrings" + + beReadOnly ifTrue: [aDiskStream readOnly] ifFalse: [aDiskStream readWrite]. + + ^(self new stream: aDiskStream; offsetToPartition: + ((MasterBootRecord of: aDiskStream) offsetToPartition: 1 sectorSize: 512)) initializeFAT. +! ! + +!FAT32FileSystem class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: bytes + ^ (self new contents: bytes) +! ! + + +FAT32FileSystem initialize! + diff --git a/modules/NOS/FileSystems/FAT32/FAT32FileSystemTest.Class.st b/modules/NOS/FileSystems/FAT32/FAT32FileSystemTest.Class.st new file mode 100644 index 00000000..a19cd152 --- /dev/null +++ b/modules/NOS/FileSystems/FAT32/FAT32FileSystemTest.Class.st @@ -0,0 +1,69 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #FAT32FileSystemTest category: 'SqueakNOS-Filesystems-FAT32'! +TestCase subclass: #FAT32FileSystemTest + instanceVariableNames: 'device' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems-FAT32'! +!FAT32FileSystemTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +memoryFilesystem + | memory | + memory := ByteArray new: 40 * 1024 * 1024. + ^(FAT32FileSystem on: memory) format +! ! + +!FAT32FileSystemTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +standardChangesStream + ^'testData/SqueakNos.changes' asFileReference readStream +! ! + +!FAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test005Creation + self shouldnt: [self memoryFilesystem] raise: Error. + +! ! + +!FAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test010BootRecord + | br | + br := self memoryFilesystem bootRecord. + self assert: br bytesPerSector = 512; + assert: br sectorsPerCluster = 1; + assert: br reservedSectors = 16r20; + assert: br numberOfCopiesOfFAT = 2; + assert: br mediaDescriptor = 16rF8; + assert: br sectorsPerTrack = 16r20; + assert: br numberOfHeads = 64; +" assert: br numberOfHiddenSectors = 16r20;" +" assert: br numberOfSectorsInPartition = 16r0107E0;" +" assert: br sectorsPerFAT = 16r020C;" + assert: br flags = 0; + assert: br versionOfFAT32Drive = 0; + assert: br clusterNumberOfStartOfRootDir = 2; + assert: br sectorNumberOfFSInformationSector = 1; + assert: br logicalDriveNumberOfPartition = 16r80; + assert: br extendedSignature = 16r29; + assert: br volumeNameOfPartition = 'NO NAME '; + assert: br fatName = 'FAT32 '; + "assert: br executableCode = ;" + assert: br bootRecordSignature = 16rAA55. + +! ! + +!FAT32FileSystemTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +test020EmptyRoot + | root | + root := self memoryFilesystem root. + self + assert: root directories size equals: 0; + assert: root files size equals: 0 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'FAT32FileSystemTest class' category: 'SqueakNOS-Filesystems-FAT32'! +FAT32FileSystemTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/FileSystems/MultiByteFilesystemFileStream.Class.st b/modules/NOS/FileSystems/MultiByteFilesystemFileStream.Class.st new file mode 100644 index 00000000..ad0650ef --- /dev/null +++ b/modules/NOS/FileSystems/MultiByteFilesystemFileStream.Class.st @@ -0,0 +1,155 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #MultiByteFilesystemFileStream category: 'SqueakNOS-Filesystems'! +MultiByteFileStream subclass: #MultiByteFilesystemFileStream + instanceVariableNames: 'offset resize' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems'! +!MultiByteFilesystemFileStream commentStamp: '' prior: 0! + +I am a filesystem-aware verion of the already deprecated MultiByteFileStream. My prim* version of methods uses the filesystem instead of the vm file primitives. +! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + ^self primClose: fileID. +! ! + +!MultiByteFilesystemFileStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +filesystem + ^ fileID filesystem +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +for: aFile + fileID := aFile. + name := aFile name. + self register. + offset := 0. + rwmode := true. + resize := false. + buffer1 := String new: 1. + self enableReadBuffering. + converter := UTF8TextConverter new. + self detectLineEndConvention. + +! ! + +!MultiByteFilesystemFileStream methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + offset := 0. + resize := false +! ! + +!MultiByteFilesystemFileStream methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:32:25'! +open: fileName forWrite: writeMode + "Do nothing" +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +primAtEnd: id + ^offset >= fileID size + +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +primClose: id + resize ifFalse: [^true]. + id filesystem cleanExtraSpace: id; flush. + ^true +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +primFlush: id + id filesystem flush +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +primGetPosition: id + ^offset +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +primRead: id into: byteArray startingAt: start count: max + "Read up to count bytes of data from this file into the given string or byte array starting at the given index. Answer the number of bytes actually read." + | count contents read | + count := max min: self size - offset. + contents := id filesystem + contentsFor: id + startingAt: offset + count: count. + read := contents size. + byteArray replaceFrom: start to: start + read - 1 with: contents. + self primSetPosition: id to: (self primGetPosition: id) + read. + ^read +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +primSetPosition: id to: anInteger + anInteger > id size ifTrue: [self error: 'Out of bounds']. + offset := anInteger +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +primSize: id + "Answer the size of this file." + ^fileID size +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +primTruncate: id to: aSize + "Truncate this file to the given position." + fileID filesystem updateSizeOf: fileID with: aSize +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +primWrite: id from: stringOrByteArray startingAt: startIndex count: count + "Write count bytes onto this file from the given string or byte array starting at the given index. Answer the number of bytes written." + | bytesWritten pos | + pos := self primGetPosition: id. + bytesWritten := id filesystem + writeOn: id + startingAt: pos + contents: stringOrByteArray + startingAt: 1 + count: count. + self updateSizeAfterWriteUpTo: pos + bytesWritten. + self primSetPosition: id to: pos + bytesWritten. + ^bytesWritten + + +! ! + +!MultiByteFilesystemFileStream methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:32:25'! +readOnlyCopy + ^self copy readOnly. +! ! + +!MultiByteFilesystemFileStream methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +updateSizeAfterWriteUpTo: aNumber + aNumber > fileID size ifTrue: [fileID filesystem updateSizeOf: fileID with: aNumber]. +! ! + +!MultiByteFilesystemFileStream methodsFor: 'readability' stamp: 'KenD 28/Jun/2026 13:32:25'! +writeOnly + super readWrite. + resize := true. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MultiByteFilesystemFileStream class' category: 'SqueakNOS-Filesystems'! +MultiByteFilesystemFileStream class + instanceVariableNames: ''! + +!MultiByteFilesystemFileStream class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +for: aFile + ^self new for: aFile. + +! ! + + +MultiByteFilesystemFileStream initialize! + diff --git a/modules/NOS/FileSystems/NOSDirectory.Class.st b/modules/NOS/FileSystems/NOSDirectory.Class.st new file mode 100644 index 00000000..816a5da0 --- /dev/null +++ b/modules/NOS/FileSystems/NOSDirectory.Class.st @@ -0,0 +1,62 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NOSDirectory category: 'SqueakNOS-Filesystems'! +NOSFilesystemContent subclass: #NOSDirectory + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems'! +!NOSDirectory methodsFor: 'quering' stamp: 'KenD 28/Jun/2026 13:32:25'! +directories + ^self filesystem directoriesFor: self +! ! + +!NOSDirectory methodsFor: 'quering' stamp: 'KenD 28/Jun/2026 13:32:25'! +fileExists: aString + ^self files anySatisfy: [:file | file name asLowercase = + (String streamContents: [:stream | (filesystem nameFormat: aString) asFileReference gtDisplayOn: stream]) asLowercase] +! ! + +!NOSDirectory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +fileNamed: aString + ^self files detect: [:file | file name asLowercase = + (String streamContents: [:stream | (filesystem nameFormat: aString) asFileReference gtDisplayOn: stream]) asLowercase] +! ! + +!NOSDirectory methodsFor: 'quering' stamp: 'KenD 28/Jun/2026 13:32:25'! +files + ^self filesystem filesFor: self +! ! + +!NOSDirectory methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isDirectory + ^true +! ! + +!NOSDirectory methodsFor: 'quering' stamp: 'KenD 28/Jun/2026 13:32:25'! +newFileNamed: aString + ^self filesystem createFileNamed: aString on: self. +! ! + +!NOSDirectory methodsFor: 'quering' stamp: 'KenD 28/Jun/2026 13:32:25'! +printString + ^self filesystem printStringOf: self. +! ! + +!NOSDirectory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +readOnlyFileNamed: aString + ^self fileNamed: aString +! ! + +!NOSDirectory methodsFor: 'quering' stamp: 'KenD 28/Jun/2026 13:32:25'! +removeFileNamed: aString + ^self filesystem removeFileNamed: aString on: self. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NOSDirectory class' category: 'SqueakNOS-Filesystems'! +NOSDirectory class + instanceVariableNames: ''! + + diff --git a/modules/NOS/FileSystems/NOSFile.Class.st b/modules/NOS/FileSystems/NOSFile.Class.st new file mode 100644 index 00000000..9fff94f8 --- /dev/null +++ b/modules/NOS/FileSystems/NOSFile.Class.st @@ -0,0 +1,259 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NOSFile category: 'SqueakNOS-Filesystems'! +NOSFilesystemContent subclass: #NOSFile + instanceVariableNames: 'size' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems'! +!NOSFile methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:32:25'! +basicOpenForWrite: writeMode + "Open the file with the given name. If writeMode is true, allow writing, otherwise open the file in read-only mode." + | fullName | + fullName := FilePathEncoder encode: name. + ^ self class + retryWithGC: [ self primOpen: fullName writable: writeMode ] + until:[ :id | id notNil ] + forFileNamed: fullName +! ! + +!NOSFile methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents + ^self readStream contents + +! ! + +!NOSFile methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:32:25'! +delete + "We retries with GC because in some platforms open files cannot be open" + self class + retryWithGC: [ self primDelete: name ] + until: [ :result | result notNil ] + forFileNamed: name. + self exists + ifTrue: [ (CannotDeleteFileException new messageText: 'Could not delete file ' , name,'. Check the file is not open.') signal ]. +! ! + +!NOSFile methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:32:25'! +exists + + | handle | + "We open it for read. If the returned handle is nil, the file could not be opened" + handle := self basicOpenForWrite: false. + handle ifNil: [^ false]. + self class primClose: handle. + ^ true +! ! + +!NOSFile methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isFile + ^true +! ! + +!NOSFile methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + + ^ name +! ! + +!NOSFile methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +named: fileName + + name := FilePathEncoder encode: fileName +! ! + +!NOSFile methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:32:25'! +openForAppend + + | stream | + stream := self openForWrite: true. + ^ stream setToEnd; yourself +! ! + +!NOSFile methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:32:25'! +openForRead + + ^ self openForWrite: false +! ! + +!NOSFile methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:32:25'! +openForWrite + + ^ self openForWrite: true +! ! + +!NOSFile methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:32:25'! +openForWrite: writeMode + "Open the file with the given name. If writeMode is true, allow writing, otherwise open the file in read-only mode." + | fileHandle | + fileHandle := self basicOpenForWrite: writeMode. + fileHandle ifNil: [ FileException signal: 'cannot open file: ', name ]. + ^ self readWriteStream +! ! + +!NOSFile methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primDelete: aFileName + "Delete the file of the given name. + Return self if the primitive succeeds, nil otherwise." + + + ^ nil +! ! + +!NOSFile methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primOpen: fileName writable: writableFlag + ^self +! ! + +!NOSFile methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream + nextPutAll: 'NOS File: ' , self name, ' (', identifier hex, ')' +! ! + +!NOSFile methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +readStream + | stream | + stream := MultiByteFilesystemFileStream for: self. + stream readOnly. + ^stream +! ! + +!NOSFile methodsFor: 'streaming' stamp: 'KenD 28/Jun/2026 13:32:25'! +readStreamDo: aBlock + | stream | + stream := self readStream. + ^ [ aBlock value: stream ] + ensure: [ stream close ] +! ! + +!NOSFile methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +readWriteStream + | stream | + stream := MultiByteFilesystemFileStream for: self. + ^stream +! ! + +!NOSFile methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ size +! ! + +!NOSFile methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size: anInteger + size := anInteger +! ! + +!NOSFile methodsFor: 'registry' stamp: 'KenD 28/Jun/2026 13:32:25'! +unregister + ^self class unregister: self +! ! + +!NOSFile methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +writeStream + | stream | + stream := MultiByteFilesystemFileStream for: self. + stream writeOnly. + ^stream +! ! + +!NOSFile methodsFor: 'streaming' stamp: 'KenD 28/Jun/2026 13:32:25'! +writeStreamDo: aBlock + | stream | + stream := self writeStream. + ^ [ aBlock value: stream ] + ensure: [ stream close ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NOSFile class' category: 'SqueakNOS-Filesystems'! +NOSFile class + instanceVariableNames: ''! + +!NOSFile class methodsFor: 'file creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +named: fileName + "Open a file with the given name for reading and writing. If the name has no directory part, then the file will be created in the default directory. If the file already exists, its prior contents may be modified or replaced, but the file will not be truncated on close." + + ^ self new named: fileName +! ! + +!NOSFile class methodsFor: 'registry' stamp: 'KenD 28/Jun/2026 13:32:25'! +named: aString identifier: anId filesystem: aFilesystem directory: aDirectory size: size + ^ self new + name: aString; + identifier: anId; + filesystem: aFilesystem; + directory: aDirectory; + size: size +! ! + +!NOSFile class methodsFor: 'file creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +openAndTruncateForWriteFileNamed: aName + + ^ (self named: aName) + delete; + openForWrite +! ! + +!NOSFile class methodsFor: 'file creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +openForReadFileNamed: aName + + ^ (self named: aName) + openForRead +! ! + +!NOSFile class methodsFor: 'file creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +openForWriteFileNamed: aName + + ^ (self named: aName) openForWrite +! ! + +!NOSFile class methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primClose: id + "Close this file." + + + self primitiveFailed +! ! + +!NOSFile class methodsFor: 'registry' stamp: 'KenD 28/Jun/2026 13:32:25'! +register: anObject + ^self registry add: anObject +! ! + +!NOSFile class methodsFor: 'registry' stamp: 'KenD 28/Jun/2026 13:32:25'! +registry + ^Registry ifNil: [Registry := WeakRegistry new] + +! ! + +!NOSFile class methodsFor: 'registry' stamp: 'KenD 28/Jun/2026 13:32:25'! +retryWithGC: execBlock until: testBlock forFileNamed: fullName + "Some platforms, like Windows, will fail if we try to open a file twice. + However, sometimes it may happen that a file was unreferenced and should be garbage-collected. + The purpose of this method is to try to open the file, and if it fails, launch a garbage collection to try to close the unreferenced files. + Then we will retry again to open the file" + + | blockValue foundIt | + blockValue := execBlock value. + (testBlock value: blockValue) ifTrue:[^blockValue]. + + "Optimization: See if we have a file with the given name. Not really needed" + foundIt := self registry keys "hold on strongly for now" + anySatisfy:[:file| file name sameAs: fullName]. + foundIt ifFalse:[^blockValue]. + + Smalltalk garbageCollectMost. + blockValue := execBlock value. + (testBlock value: blockValue) ifTrue:[^blockValue]. + Smalltalk garbageCollect. + ^execBlock value. +! ! + +!NOSFile class methodsFor: 'registry' stamp: 'KenD 28/Jun/2026 13:32:25'! +unregister: anObject + ^self registry remove: anObject ifAbsent:[] +! ! + + diff --git a/modules/NOS/FileSystems/NOSFilesystemContent.Class.st b/modules/NOS/FileSystems/NOSFilesystemContent.Class.st new file mode 100644 index 00000000..baee5c33 --- /dev/null +++ b/modules/NOS/FileSystems/NOSFilesystemContent.Class.st @@ -0,0 +1,94 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NOSFilesystemContent category: 'SqueakNOS-Filesystems'! +Object subclass: #NOSFilesystemContent + instanceVariableNames: 'name identifier filesystem directory' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Filesystems'! +!NOSFilesystemContent commentStamp: '' prior: 0! + +Me and my subclasses have been copied from the Pharo versions. +FIXME: this is highly work-in-progress. + Check what is really needed from this hierarchy +! + +!NOSFilesystemContent methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +directory + ^directory +! ! + +!NOSFilesystemContent methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +directory: aDirectory + directory := aDirectory +! ! + +!NOSFilesystemContent methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +filesystem + ^filesystem +! ! + +!NOSFilesystemContent methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +filesystem: aFilesystem + filesystem := aFilesystem +! ! + +!NOSFilesystemContent methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +identifier + ^identifier +! ! + +!NOSFilesystemContent methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +identifier: aClusterNumber + identifier := aClusterNumber +! ! + +!NOSFilesystemContent methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isDirectory + ^false +! ! + +!NOSFilesystemContent methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isFile + ^false +! ! + +!NOSFilesystemContent methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + ^name +! ! + +!NOSFilesystemContent methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name: aString + name := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NOSFilesystemContent class' category: 'SqueakNOS-Filesystems'! +NOSFilesystemContent class + instanceVariableNames: ''! + +!NOSFilesystemContent class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +identifier: anId filesystem:aFilesystem + ^self named: '' + identifier: anId + filesystem: aFilesystem. +! ! + +!NOSFilesystemContent class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +named: aString identifier: anId filesystem: aFilesystem + ^self new name: aString; + identifier: anId; + filesystem: aFilesystem. +! ! + +!NOSFilesystemContent class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +named: aString identifier: anId filesystem: aFilesystem directory: aDirectory + ^self new name: aString; + identifier: anId; + filesystem: aFilesystem; + directory: aDirectory. +! ! + + diff --git a/modules/NOS/Kernel/Computer.Class.st b/modules/NOS/Kernel/Computer.Class.st new file mode 100644 index 00000000..1e5d29ea --- /dev/null +++ b/modules/NOS/Kernel/Computer.Class.st @@ -0,0 +1,473 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #Computer category: #'SqueakNOS-Kernel'! +Object subclass: #Computer + instanceVariableNames: 'devices info processor memoryManager ramdisk primaryFilesystem' + classVariableNames: 'Current PageFaultHandler Saving' + poolDictionaries: '' + category: 'SqueakNOS-Kernel'! +!Computer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +add: aHardwareDevice named: aSymbol + Transcript cr; show: aHardwareDevice printString, ' installed as ', aSymbol. + ^ devices at: aSymbol put: aHardwareDevice +! ! + +!Computer methodsFor: 'filesystem' stamp: 'KenD 28/Jun/2026 13:32:25'! +diskFS + | device | + [ device := ATAController primary master. + device information ] + on: Error + do: [ device := ATAController primary slave. + device reset ]. + ^ (FAT32FileSystem on: device primaryPartition) open +! ! + +!Computer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +doesNotUnderstand: aMessage + | selector | + "it would be nice to compile the accessor the first time it's used" + selector := aMessage selector. + (aMessage arguments size = 1 and: [selector last = $:]) + ifTrue: [ + ^ self add: aMessage arguments first + named: selector allButLast asSymbol]. + + ^ devices at: aMessage selector ifAbsent: [ + super doesNotUnderstand: aMessage] + +! ! + +!Computer methodsFor: 'memory' stamp: 'KenD 28/Jun/2026 13:32:25'! +enablePaging + memoryManager := PageManager forMemory: self memory using: processor. + memoryManager installOn: self. + +! ! + +!Computer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +has: aSymbol + ^ devices includesKey: aSymbol +! ! + +!Computer methodsFor: 'image' stamp: 'KenD 28/Jun/2026 13:32:25'! +imageEndAddress + ^(KernelModule fromHandle: (ExternalAddress new fromInteger: info multiboot modsAddress)) end +! ! + +!Computer methodsFor: 'image' stamp: 'KenD 28/Jun/2026 13:32:25'! +imageStartAddress + ^(KernelModule fromHandle: (ExternalAddress new fromInteger: info multiboot modsAddress)) start +! ! + +!Computer methodsFor: 'image' stamp: 'KenD 28/Jun/2026 13:32:25'! +inPageFault + ^info inPageFault +! ! + +!Computer methodsFor: 'image' stamp: 'KenD 28/Jun/2026 13:32:25'! +inPageFault: anInteger + info inPageFault: anInteger +! ! + +!Computer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +info + ^info +! ! + +!Computer methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + self currentWorld + flash; + fullRepaintNeeded. + processor := X86Processor new. + devices := Dictionary new. + self class tweakSqueakForSqueakNOS. + PIC8259 installOn: self. + PCIBusEntry allValid + do: [ :bus | "Transcript + show: bus; + cr; + cr" ]. + "OldPCKeyboard installOn: Current. " + PS2Keyboard installOn: self. + "self defaultNetworkInterface: nil." + "self initializeBridge." + "Memory installOn: self." + "self enablePaging." + UART16550 installOn: self. + CMOS installOn: self. + "RemoteObjectChannel installOn: self." + "LancePCIDevice installOn: self." + self defaultNetworkInterface: nil. + Realtek8139PCIDevice installOn: self. + self defaultNetworkInterface + ifNotNil: [ self networkingStack: (EthernetInterface on: self defaultNetworkInterface) ]. + " + USBUHCIController installOn: self. + SDDevice installOn: self." + ATAController primary installOn: self. + ramdisk := ByteArray new: 128 * 1024 * 1024. + ATAController primary + at: 1 + count: ramdisk size / 512 + of: 0 + into: ramdisk. + primaryFilesystem := self ramdiskFS. + self openSourceFiles. + Display forceToScreen + "(self confirm: 'Do you want to load sources from disk?') ifTrue: [self openSourceFiles]" +! ! + +!Computer methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +initializeBridge + info := VMBridge fromHandle: (ExternalAddress new fromInteger: self primVMBiosInformationPosition) + +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +isSqueakNOS + ^ self class isSqueakNOS +! ! + +!Computer methodsFor: 'image' stamp: 'KenD 28/Jun/2026 13:32:25'! +kernelPageAt: anAddress + ^info snapshotInfo pageFor: anAddress +! ! + +!Computer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +memory + ^devices at: #memory +! ! + +!Computer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +memory: aMemory + devices at: #memory put: aMemory +! ! + +!Computer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +memoryManager + ^memoryManager +! ! + +!Computer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +memoryManager: aMemoryManager + memoryManager := aMemoryManager +! ! + +!Computer methodsFor: 'sources loading' stamp: 'KenD 28/Jun/2026 13:32:25'! +openSourceFiles + | filesystem directory source sources changes change | + "Smalltalk imageName = SmalltalkImage lastImageName + ifFalse: [SmalltalkImage lastImageName: Smalltalk imageName. + Smalltalk isPharo ifTrue: [ Author fullName: '' ] ifFalse: [ Utilities setAuthorInitials: '' ] ]." + filesystem := self primaryFilesystem. + sources := filesystem pureFAT32FilenameFor: Smalltalk sourcesName. + sources := sources copyFrom: 2 to: sources size. + changes := filesystem pureFAT32FilenameFor: Smalltalk changesName. + directory := filesystem root. + (directory fileExists: sources) + ifTrue: [ source := (directory readOnlyFileNamed: sources) readStream ]. + (directory fileExists: changes) + ifTrue: [ change := (directory readOnlyFileNamed: changes) readWriteStream ]. + SourceFiles + changesFileStream: change; + sourcesFileStream: source +! ! + +!Computer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pageFaultAddress + ^info pageFaultAddress +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primAllocationBetweenGCs: anInteger + + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primDisableConsole + + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primEnableConsole + + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primEndOfVM + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primInPortByte: portNumber + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primMultibootInfoFromGrub + + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primOFWCallout: anArray + + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primOutPort: portNumber byte: byte + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primRegisterSemaphoreIndex: t1 forIRQ: t2 + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'image' stamp: 'KenD 28/Jun/2026 13:32:25'! +primShutDown + + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primVMBiosInformationPosition + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!Computer methodsFor: 'filesystem' stamp: 'KenD 28/Jun/2026 13:32:25'! +primaryFilesystem + ^ primaryFilesystem ifNil: [ primaryFilesystem := self diskFS ] +! ! + +!Computer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +processor + ^ processor +! ! + +!Computer methodsFor: 'filesystem' stamp: 'KenD 28/Jun/2026 13:32:25'! +ramdiskFS + | sectorSize boot record start partitionSize partition | + sectorSize := 512. + boot := MasterBootRecord on: (ramdisk copyFrom: 1 to: sectorSize). + record := boot partitionRecord: 1. + start := record offsetFromMBR * sectorSize +1. + partitionSize := record numberOfSectors * sectorSize. + partition := ramdisk segmentFrom: start size: partitionSize. + ^ (FAT32FileSystem on: partition) open +! ! + +!Computer methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +registerSemaphore: aSemaphore forIRQ: irqNumber + | semaIndex | + semaIndex := Smalltalk registerExternalObject: aSemaphore. + ^ self primRegisterSemaphoreIndex: semaIndex forIRQ: irqNumber +! ! + +!Computer methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +reset + self keyboard controllerCommand: 16rF0. + self keyboard controllerCommand: 16rD1; dataPort: 0. +! ! + +!Computer methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +resetSnapshotInfo + self totalPageFaults: 0. + info snapshotInfo saved: 0; toSave: 500; resetPages + +! ! + +!Computer methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +setInitialMemoryState + | image multiboot map | + multiboot := info multiboot. + multiboot areModulesValid ifTrue: [image := KernelModule fromHandle: (ExternalAddress new fromInteger: multiboot modsAddress)]. + multiboot areMemoryAddressesValid ifTrue: [self memory size: info multiboot memUpper + 1024 * 1024]. + "multiboot isMemoryMapValid ifTrue: [ + map := MultiBootMemoryMap fromHandle: (ExternalAddress new fromInteger: multiboot mmapAddress) size: multiboot mmapLength. + map do: [:entry | | base | entry type = 1 ifFalse: [base := entry baseAddress. self memory alreadyReserved: (base to: base + entry length) for: 'Reserved']] + ]". + self memory + alreadyReserved: (0 to: 1048575) for: 'First mega of low memory for bios, drivers, etc.'; + alreadyReserved: (1048576 to: self primEndOfVM) for: 'Virtual Machine code and data structures'; + alreadyReserved: (image start to: image end) for: 'Object memory (image)'. + + + +! ! + +!Computer methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +setSnapshotEndAddress + self snapshotEndAddress: self memory biggestEmptyBlock end. + +! ! + +!Computer methodsFor: 'snapshotting' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshotEndAddress + ^info snapshotEndAddress - Smalltalk headerSize. +! ! + +!Computer methodsFor: 'snapshotting' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshotEndAddress: anInteger + info snapshotEndAddress: anInteger +! ! + +!Computer methodsFor: 'snapshotting' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshotStartAddress + ^info snapshotStartAddress +! ! + +!Computer methodsFor: 'snapshotting' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshotStartAddress: anInteger + info snapshotStartAddress: anInteger +! ! + +!Computer methodsFor: 'image' stamp: 'KenD 28/Jun/2026 13:32:25'! +totalPageFaults + ^info totalPageFaults +! ! + +!Computer methodsFor: 'image' stamp: 'KenD 28/Jun/2026 13:32:25'! +totalPageFaults: anInteger + info totalPageFaults: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Computer class' category: #'SqueakNOS-Kernel'! +Computer class + instanceVariableNames: 'Current PageFaultHandler Saving'! + +!Computer class methodsFor: 'filesystem' stamp: 'KenD 28/Jun/2026 13:32:25'! +blankBlockDeviceForTest + ^self isSqueakNOS + ifTrue: [ self blankDiskOnRealDiskForTest ] + ifFalse: [self blankDiskOnFileForTest ]. +! ! + +!Computer class methodsFor: 'filesystem' stamp: 'KenD 28/Jun/2026 13:32:25'! +blankDiskOnFileForTest + ^BlockDeviceOnStream on: (StandardFileStream fileNamed: './testdata/blank') blockSize: 512. +! ! + +!Computer class methodsFor: 'filesystem' stamp: 'KenD 28/Jun/2026 13:32:25'! +blankDiskOnRealDiskForTest + ^ATAController secondary slave. +! ! + +!Computer class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +current + ^ Current +! ! + +!Computer class methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + SessionManager default + registerGuiClassNamed: self name + +! ! + +!Computer class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isPharo + ^true + +! ! + +!Computer class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isSqueakNOS + ^Smalltalk os platformName = 'SqueakNOS' + +! ! + +!Computer class methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primPullDebugString + + ^ self primitiveFailed +! ! + +!Computer class methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primPushDebugString: aString + + ^ self primitiveFailed +! ! + +!Computer class methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primRegisterSemaphoreIndex: t1 forIRQ: t2 + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!Computer class methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:32:25'! +show: aString + self isSqueakNOS + ifTrue: [ self primPushDebugString: aString, String lf] + ifFalse: [ Transcript show: aString ] +! ! + +!Computer class methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:32:25'! +showCallTrace + | stream | + stream := '' writeStream. + thisContext printDebugOn: stream. + Transcript show: stream contents. + +! ! + +!Computer class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +shutDown: quitting + self isSqueakNOS ifTrue: [ + snapshotter := (ImageSnapshotter on: self current) prepareToWriteSnapshot. + Saving := true. + ] +! ! + +!Computer class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +startUp: resuming + self isSqueakNOS + ifTrue: [ + resuming ifTrue: [ + Transcript cr; show: 'This is SqueakNOS!!!!!! :-)'; cr. + self startUpPCComputer + ] ifFalse: [ + snapshotter ifNotNil: [: s | s snapshot. snapshotter := nil] + ] + ] ifFalse: [ + Transcript cr; show: 'This is not SqueakNOS!! :-('; cr. + ] +! ! + +!Computer class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +startUpPCComputer + Current := self new. + + +! ! + +!Computer class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +tweakSqueakForSqueakNOS + EpSettings monitorEnabled: false. + Smalltalk tools workspaceTool: Workspace. + true + ifFalse: [ | tmp2 | + tmp2 := Smalltalk. + tmp2 + removeFromStartUpList: #SecurityManager; + removeFromStartUpList: #FileDirectory; + removeFromShutDownList: #FileDirectory. + #Debugger logDebuggerStackToFile: false ] +! ! + + +Computer initialize! + diff --git a/modules/NOS/Kernel/ExternalIOPort.Class.st b/modules/NOS/Kernel/ExternalIOPort.Class.st new file mode 100644 index 00000000..143cccc2 --- /dev/null +++ b/modules/NOS/Kernel/ExternalIOPort.Class.st @@ -0,0 +1,206 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #ExternalIOPort category: #'SqueakNOS-Devices-Base'! +Object subclass: #ExternalIOPort + instanceVariableNames: 'address' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Base'! +!ExternalIOPort commentStamp: '' prior: 0! + +This is 1 based to match ExternalAddress accessors, this adds a double stupid overhead on every accessors. Read comment for HardwareDevice class +! + +!ExternalIOPort methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +address: anInteger + address := anInteger - 1 +! ! + +!ExternalIOPort methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +asInteger + ^ address + 1 +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primInPortByte: portNumber + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primInPortByte: portNumber stringLength: length + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primInPortDword: portNumber + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primInPortDword: portNumber stringLength: length + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primInPortWord: portNumber + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primInPortWord: portNumber stringLength: length + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primOutPort: portNumber byte: byte + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primOutPort: portNumber byteString: aString + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primOutPort: portNumber dword: dword + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primOutPort: portNumber dwordString: aString + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primOutPort: portNumber word: word + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:24'! +primOutPort: portNumber wordString: aString + "primitiveExternalCall" + ^ self primitiveFailed +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +uByteAtOffset: offset + ^ self primInPortByte: address + 1 + offset +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +uByteAtOffset: offset put: byte + ^ self primOutPort: address + 1 + offset byte: byte +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedByteAt: index + ^ self primInPortByte: address + index + + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedByteAt: index put: value + ^ self primOutPort: address + index byte: value + + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedByteStringAt: index put: string + ^ self primOutPort: address + index byteString: string + + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedByteStringAt: index size: size + ^ self primInPortByte: address + index stringLength: size + + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedLongAt: index + ^ self primInPortDword: address + index + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedLongAt: index put: value + ^ self primOutPort: address + index dword: value + + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedLongStringAt: index put: string + ^ self primOutPort: address + index dwordString: string + + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedLongStringAt: index size: size + ^ self primInPortDword: address + index stringLength: size + + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedShortAt: index + ^ self primInPortWord: address + index + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedShortAt: index put: value + ^ self primOutPort: address + index word: value + + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedShortStringAt: index put: string + ^ self primOutPort: address + index wordString: string + + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedShortStringAt: index size: size + ^ self primInPortWord: address + index stringLength: size + + +! ! + +!ExternalIOPort methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:24'! +unsignedWordStringAt: index size: size + ^ self primInPortWord: address + index stringLength: size + + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExternalIOPort class' category: #'SqueakNOS-Devices-Base'! +ExternalIOPort class + instanceVariableNames: ''! + +!ExternalIOPort class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +address: anInteger + ^ self new address: anInteger +! ! + + diff --git a/modules/NOS/Kernel/HardwareDevice.Class.st b/modules/NOS/Kernel/HardwareDevice.Class.st new file mode 100644 index 00000000..6b2cd0bd --- /dev/null +++ b/modules/NOS/Kernel/HardwareDevice.Class.st @@ -0,0 +1,165 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #HardwareDevice category: 'SqueakNOS-Devices-Base'! +Object subclass: #HardwareDevice + instanceVariableNames: 'resource' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Devices-Base'! +!HardwareDevice commentStamp: '' prior: 0! + +I'm a HadwareDevice. My subclasses implement support for different devices, for example, Keyboard, Mouse, Network cards, PCI support, etc. + +My baseResource dictates whether I use ExternalMemory or ExternalOPort to talk to the hardware. + +All accessors #(byteAt: shortAt: longAt: byteAt:put: shortAt:put: longAt:put:) are zero based. This is different from Smalltalk convention, and it was not an easy decision, but we finally opted for 0 based accessors to match all existing documentation for devices, so it's a lot easy to follow from code to documentation and back. + +To do this zero based accessing we are playing silly and processor consuming tricks right now, we'll probably improve this in the future. The trick is: ExternalAddress (as implemented by stock Squeak) is 1 based, so we have to add one to the index before accessing the resources, howerver, in the native implementation, 1 has to be substracted back from the index to access the right memory address. To match this behaviour we had to make ExternalIOPort also be 1 based, so, before calling the primitives for ExternalIOPort we substract 1 to the index, and before calling the public accessors we have to add 1 to it... in short, if we could make ExternalAddress be zero based (or if we reimplement it in our own class) we could remove all this +/- 1 overhead. However, right now, we only want to make it work, and take note for the future. + +! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteAt: index + ^ resource unsignedByteAt: index + 1 +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteAt: index put: value + ^ resource unsignedByteAt: index + 1put: value +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteStringAt: index put: aString + ^ resource unsignedByteStringAt: index + 1 put: aString +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteStringAt: index size: anInteger + ^ resource unsignedByteStringAt: index + 1 size: anInteger +! ! + +!HardwareDevice methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:25'! +handleIRQ + self report: 'IRQ' +! ! + +!HardwareDevice methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:25'! +handleIRQfor: anIRQDispatcher + ^ self handleIRQ +! ! + +!HardwareDevice methodsFor: 'irq handling' stamp: 'KenD 28/Jun/2026 13:32:25'! +handleIRQfor: anIRQDispatcher on: aComputer + ^ self handleIRQfor: anIRQDispatcher +! ! + +!HardwareDevice methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +longAt: index + ^ resource unsignedLongAt: index + 1 +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +longAt: index put: value + ^ resource unsignedLongAt: index + 1 put: value +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +longStringAt: index put: aString + ^ resource unsignedLongStringAt: index + 1 put: aString +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +longStringAt: index size: anInteger + ^ resource unsignedLongStringAt: index + 1 size: anInteger +! ! + +!HardwareDevice methodsFor: 'reporting' stamp: 'KenD 28/Jun/2026 13:32:25'! +report: msg + Transcript + cr; + show: self; + nextPutAll: ': ', msg asString; + flush. +! ! + +!HardwareDevice methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +resource: anExternalIOPortOrZeroBasedAddress + resource := anExternalIOPortOrZeroBasedAddress +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +shortAt: index + ^ resource unsignedShortAt: index + 1 +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +shortAt: index put: value + ^ resource unsignedShortAt: index + 1 put: value +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +shortStringAt: index put: aString + ^ resource unsignedShortStringAt: index + 1 put: aString +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +shortStringAt: index size: anInteger + ^ resource unsignedShortStringAt: index + 1 size: anInteger +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedByteAt: index + ^ resource unsignedByteAt: index + 1 +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedByteAt: index put: value + ^ resource unsignedByteAt: index + 1 put: value +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShoftAt: index put: value + ^ resource unsignedShortAt: index + 1 put: value +! ! + +!HardwareDevice methodsFor: 'I/O' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAt: index + ^ resource unsignedShortAt: index + 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HardwareDevice class' category: 'SqueakNOS-Devices-Base'! +HardwareDevice class + instanceVariableNames: ''! + +!HardwareDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +atMemoryAddress: anInteger + ^ self basicNew resource: (ExternalAddress new fromInteger: anInteger); + initialize +! ! + +!HardwareDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +installOn: aComputer + " detect if hardware is present, if so, instantiate, initialize and install on aComputer" +! ! + +!HardwareDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + + ^ super new initialize +! ! + +!HardwareDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +onPort: portNumber + ^ self basicNew resource: (ExternalIOPort address: portNumber); + initialize +! ! + + +HardwareDevice initialize! + diff --git a/modules/NOS/Kernel/ImageSnapshotter.Class.st b/modules/NOS/Kernel/ImageSnapshotter.Class.st new file mode 100644 index 00000000..7b53a63e --- /dev/null +++ b/modules/NOS/Kernel/ImageSnapshotter.Class.st @@ -0,0 +1,186 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ImageSnapshotter category: 'SqueakNOS-Kernel'! +Object subclass: #ImageSnapshotter + instanceVariableNames: 'computer savedPages' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Kernel'! +!ImageSnapshotter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +computer: aComputer + computer := aComputer +! ! + +!ImageSnapshotter methodsFor: 'handling strategies' stamp: 'KenD 28/Jun/2026 13:32:25'! +copyOnWriteHandlingBlock + ^[ :anAddress :handler | | directoryEntry pageEntry table newTable contents start manager | + manager := computer memoryManager. + directoryEntry := manager pageDirectoryEntryFor: anAddress. + directoryEntry isPresentAndAllowed ifFalse: [self error: 'Que fachemo si viene el fault en el directory?']. + pageEntry := manager pageTableEntryFor: anAddress. + pageEntry isPresentAndForbidden ifFalse: [pageEntry isPresent ifTrue: [self] ifFalse: [ handler doDefaultHandlingFor: anAddress ]] + ifTrue:[ + contents := self pageContentsOf: anAddress. + start := manager pageStartAddressOf: anAddress. + savedPages at: start put: contents. + pageEntry setPresentAndWritable + ] + ] + +! ! + +!ImageSnapshotter methodsFor: 'internal' stamp: 'KenD 28/Jun/2026 13:32:25'! +imageFileStreamForWrite + | filesystem image contents directory name bytearray | + filesystem := computer primaryFilesystem. + directory := filesystem root. + name := Smalltalk imageName. + image := (directory fileExists: name) ifTrue: [directory fileNamed: name] ifFalse: [directory newFileNamed: name]. + ^image writeStream +! ! + +!ImageSnapshotter methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +imageMemoryReadOnlyPageContents: aNumber + | size address contents manager | + manager := computer memoryManager. + size := manager pageSize. + address := self objectMemoryStartAddress + (aNumber - 1 * size) bitAnd: 16rFFFFF000. + ^savedPages at: address ifAbsent: [ + (computer kernelPageAt: address) ifNotNilDo: [:page | page contents] ifNil: [ + contents := (Buffer at: address size: 4096) contents. + (manager pageTableEntryFor: address) readWrite. + contents := (computer kernelPageAt: address) ifNil: [contents]. + contents + ] + ] +! ! + +!ImageSnapshotter methodsFor: 'internal' stamp: 'KenD 28/Jun/2026 13:32:25'! +imagePagesCount + | image pageSize startAddress rest firstSpace addendum | + image := self size. + pageSize := computer memoryManager pageSize. + startAddress := self objectMemoryStartAddress. + addendum := 0. + startAddress isPageAligned ifFalse: [ + rest := (image \\ pageSize). + firstSpace := (startAddress bitOr: 16r00000FFF) - startAddress. + (firstSpace > rest) ifFalse: [addendum := 1]. + ]. + ^(image / pageSize) ceiling + addendum +! ! + +!ImageSnapshotter methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + savedPages := Dictionary new. +! ! + +!ImageSnapshotter methodsFor: 'internal' stamp: 'KenD 28/Jun/2026 13:32:25'! +objectMemoryStartAddress + ^self startAddress + Smalltalk headerSize +! ! + +!ImageSnapshotter methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aComputer + ^self new computer: aComputer +! ! + +!ImageSnapshotter methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +pageContentsOf: anAddress + | start | + start := computer memoryManager pageStartAddressOf: anAddress. + ^(Buffer at: start size: computer memoryManager pageSize) contents +! ! + +!ImageSnapshotter methodsFor: 'internal' stamp: 'KenD 28/Jun/2026 13:32:25'! +postPagedSnapshot + +! ! + +!ImageSnapshotter methodsFor: 'internal' stamp: 'KenD 28/Jun/2026 13:32:25'! +postSnapshot + "self postClonedSnapshot" + self postPagedSnapshot + +! ! + +!ImageSnapshotter methodsFor: 'internal' stamp: 'KenD 28/Jun/2026 13:32:25'! +preSnapshot + "self prepareForClonedSnapshot" + +! ! + +!ImageSnapshotter methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +prepareToWriteSnapshot + | pageFaultHandler start | + computer setSnapshotEndAddress. + computer memoryManager ifNotNil: [ :manager | + pageFaultHandler := PageFaultHandler manager: manager. + pageFaultHandler handlingBlock: self copyOnWriteHandlingBlock. + start := computer imageStartAddress. + manager from: start to: start + 100000000 useHandler: pageFaultHandler. + computer resetSnapshotInfo + ] +! ! + +!ImageSnapshotter methodsFor: 'internal' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^computer snapshotEndAddress +! ! + +!ImageSnapshotter methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:25'! +snapshot + | imageCopy memory aStream | + self preSnapshot. + aStream := self imageFileStreamForWrite. + aStream binary. + self writeHeaderOn: aStream fromMemory: computer snapshotStartAddress. + self writeObjectMemory: aStream. + aStream truncate: computer snapshotEndAddress + Smalltalk headerSize; close. + self postSnapshot +! ! + +!ImageSnapshotter methodsFor: 'internal' stamp: 'KenD 28/Jun/2026 13:32:25'! +startAddress + ^computer imageStartAddress +! ! + +!ImageSnapshotter methodsFor: 'internal' stamp: 'KenD 28/Jun/2026 13:32:25'! +writeHeaderOn: aStream fromMemory: anAddress + | contents | + contents := Buffer at: anAddress size: Smalltalk headerSize. + aStream nextPutAll: contents contents +! ! + +!ImageSnapshotter methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +writeObjectMemory: aStream + | startAddress firstPageOffset pages lastAddress lastPageLimit | + pages := self imagePagesCount. + startAddress := self objectMemoryStartAddress. + firstPageOffset := startAddress - (startAddress bitAnd: 16rFFFFF000). + aStream nextPutAll: ((self imageMemoryReadOnlyPageContents: 1) allButFirst: firstPageOffset). + 2 to: pages - 1 do: [:index | | memory | + index \\ 1000 = 0 ifTrue: [Computer show: 'Writing page number ', index asString]. + aStream nextPutAll: (self imageMemoryReadOnlyPageContents: index) + ]. + lastAddress := startAddress + self size. + lastPageLimit := lastAddress - (lastAddress bitAnd: 16rFFFFF000). + aStream nextPutAll: ((self imageMemoryReadOnlyPageContents: pages) first: lastPageLimit) +! ! + +!ImageSnapshotter methodsFor: 'internal' stamp: 'KenD 28/Jun/2026 13:32:25'! +writeObjectMemory: aStream fromClonedSnapshotOn: anAddress + | contents | + contents := Buffer at: computer snapshotStartAddress size: computer snapshotEndAddress. + aStream nextPutAll: contents contents +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ImageSnapshotter class' category: 'SqueakNOS-Kernel'! +ImageSnapshotter class + instanceVariableNames: ''! + + +ImageSnapshotter initialize! + diff --git a/modules/NOS/Kernel/InterruptRequestDispatcher.Class.st b/modules/NOS/Kernel/InterruptRequestDispatcher.Class.st new file mode 100644 index 00000000..c4335336 --- /dev/null +++ b/modules/NOS/Kernel/InterruptRequestDispatcher.Class.st @@ -0,0 +1,123 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #InterruptRequestDispatcher category: 'SqueakNOS-Kernel'! +Object subclass: #InterruptRequestDispatcher + instanceVariableNames: 'semaphore process interruptNumber clients' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Kernel'! +!InterruptRequestDispatcher methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +addHandler: anObject + clients add: anObject +! ! + +!InterruptRequestDispatcher methodsFor: 'handling' stamp: 'KenD 28/Jun/2026 13:32:25'! +handleOn: aComputer +" Transcript cr; show: 'handling IRQ #', interruptNumber asString. +" clients + do: [:each | + [each handleIRQfor: self on: aComputer] + ifError: [:err :rcvr | + Transcript + nextPutAll: err; + nextPutAll: ' when handling IRQ #'; + print: interruptNumber; + nextPutAll: ' on '; + print: each; + cr; + flush. + ] + ]. +" Transcript cr; show: ' handled'. +" +! ! + +!InterruptRequestDispatcher methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + semaphore := Semaphore new. + clients := OrderedCollection new +! ! + +!InterruptRequestDispatcher methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +installOn: aComputer + self registerSemaphore. + process := [ [ semaphore wait. + self handleOn: aComputer. + interruptNumber = 46 ifTrue: [ Transcript show: 'irq ended' ]. + aComputer interruptController signalEndOfInterrupt: interruptNumber ] repeat ] + forkAt: Processor highIOPriority. + process name: 'Iterrupt Dispatcher for IRQ#:' , interruptNumber printString. + aComputer interruptController enableIRQ: interruptNumber +! ! + +!InterruptRequestDispatcher methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +interruptNumber + ^ interruptNumber +! ! + +!InterruptRequestDispatcher methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +primRegisterSemaphoreIndex: externalObjectForSemaphore forIRQ: IRQNumber + + ^ self primitiveFailed +! ! + +!InterruptRequestDispatcher methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +privInterruptNumber: irqNumber + interruptNumber + ifNil: [ + interruptNumber := irqNumber. + self registerSemaphore] + ifNotNil: [self error: 'Can''t change the IRQ number for a handler'] +! ! + +!InterruptRequestDispatcher methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +registerSemaphore + self + primRegisterSemaphoreIndex: (Smalltalk registerExternalObject: semaphore) + forIRQ: interruptNumber +! ! + +!InterruptRequestDispatcher methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +removeHandler: anObject + " should not be called from a handler routine, + as it may terminate the process if it's the last handler, + in which case the interrupt will not be finished signaling the interruptController. + XXX: This must be solved, there must be a clean wat of doing one time IRQs" + clients remove: anObject. + clients ifEmpty: [self uninstall]. +! ! + +!InterruptRequestDispatcher methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +uninstall + Computer current interruptController disableIRQ: interruptNumber. + self primRegisterSemaphoreIndex: 0 forIRQ: interruptNumber. + Computer current interruptController removeDispatcher: self. + + " the next is forked so it doesn't kill the process calling. + Of utter importance if called from within handleIRQ: + as otherwise the interrupt end will not be signaled. + The current process is running at hiIOPriority, so the + new one won't be executed until the current is idle" + [process terminate] forkAt: Processor lowIOPriority. + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InterruptRequestDispatcher class' category: 'SqueakNOS-Kernel'! +InterruptRequestDispatcher class + instanceVariableNames: ''! + +!InterruptRequestDispatcher class methodsFor: 'instace creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^ super new initialize +! ! + +!InterruptRequestDispatcher class methodsFor: 'instace creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +onIRQ: aNumber + ^ self new privInterruptNumber: aNumber +! ! + + +InterruptRequestDispatcher initialize! + diff --git a/modules/NOS/MemoryManager/MemoryManagerStrategy.Class.st b/modules/NOS/MemoryManager/MemoryManagerStrategy.Class.st new file mode 100644 index 00000000..2146cf19 --- /dev/null +++ b/modules/NOS/MemoryManager/MemoryManagerStrategy.Class.st @@ -0,0 +1,45 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #MemoryManagerStrategy category: #'SqueakNOS-Memory-Manager'! +Object subclass: #MemoryManagerStrategy + instanceVariableNames: 'memory processor' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Memory-Manager'! +!MemoryManagerStrategy methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +memory + ^memory +! ! + +!MemoryManagerStrategy methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +memory: aMemory + memory := aMemory +! ! + +!MemoryManagerStrategy methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +processor + ^processor +! ! + +!MemoryManagerStrategy methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +processor: aProcessor + processor := aProcessor. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MemoryManagerStrategy class' category: #'SqueakNOS-Memory-Manager'! +MemoryManagerStrategy class + instanceVariableNames: ''! + +!MemoryManagerStrategy class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +forMemory: aMemory + ^self new memory: aMemory; identityMapping +! ! + +!MemoryManagerStrategy class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +forMemory: aMemory using: aProcessor + ^self new memory: aMemory; processor: aProcessor; identityMapping +! ! + + diff --git a/modules/NOS/MemoryManager/PageFaultHandler.Class.st b/modules/NOS/MemoryManager/PageFaultHandler.Class.st new file mode 100644 index 00000000..7a5340a3 --- /dev/null +++ b/modules/NOS/MemoryManager/PageFaultHandler.Class.st @@ -0,0 +1,65 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PageFaultHandler category: 'SqueakNOS-Memory-Manager'! +Object subclass: #PageFaultHandler + instanceVariableNames: 'manager handlingBlock' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Memory-Manager'! +!PageFaultHandler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +defaultHandlingBlock + ^[ :anAddress :handler | | directoryEntry pageEntry | + self halt. + directoryEntry := manager pageDirectoryEntryFor: anAddress. + directoryEntry isPresentAndAllowed ifFalse: [directoryEntry setPresentAndWritable]. + pageEntry := manager pageTableEntryFor: anAddress. + pageEntry isPresentAndAllowed + ifFalse: [pageEntry setPresentAndWritable] + ifTrue: [self error: 'Why did this page faulted?'] + ] + +! ! + +!PageFaultHandler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +doDefaultHandlingFor: anAddress + self defaultHandlingBlock value: anAddress value: self + + +! ! + +!PageFaultHandler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +handlingBlock + ^ handlingBlock +! ! + +!PageFaultHandler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +handlingBlock: aHandlingBlock + handlingBlock := aHandlingBlock + +! ! + +!PageFaultHandler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + handlingBlock := self defaultHandlingBlock. +! ! + +!PageFaultHandler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +manager: aMemoryManagerStrategy + manager := aMemoryManagerStrategy +! ! + +!PageFaultHandler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +resolvePageFaultOn: anAddress + handlingBlock value: anAddress value: self. + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PageFaultHandler class' category: 'SqueakNOS-Memory-Manager'! +PageFaultHandler class + instanceVariableNames: ''! + + +PageFaultHandler initialize! + diff --git a/modules/NOS/MemoryManager/PageManager.Class.st b/modules/NOS/MemoryManager/PageManager.Class.st new file mode 100644 index 00000000..f3a339d5 --- /dev/null +++ b/modules/NOS/MemoryManager/PageManager.Class.st @@ -0,0 +1,250 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PageManager category: 'SqueakNOS-Memory-Manager'! +MemoryManagerStrategy subclass: #PageManager + instanceVariableNames: 'directory handlers pageHandled interrupted pageFaultCallback' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Memory-Manager'! +!PageManager methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +defaultPageFaultHandler + ^PageFaultHandler manager: self. +! ! + +!PageManager methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +directory + ^directory +! ! + +!PageManager methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +directory: aPageDirectory + directory := aPageDirectory +! ! + +!PageManager methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +from: startAddress to: stopAddress useHandler: aPageFaultHandler + handlers at: (startAddress to: stopAddress) put: aPageFaultHandler +! ! + +!PageManager methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +handlerFor: anAddress + | interval intervals | + handlers keys isEmpty ifTrue: [^self defaultPageFaultHandler]. + intervals := handlers keys select: [:int | int includes: anAddress]. + interval := intervals isEmpty + ifTrue: [Computer show: 'No handling interval for address ', anAddress printString. Computer show: handlers printString. 0] + ifFalse: [intervals min]. + ^handlers at: interval + + + + +! ! + +!PageManager methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:24'! +identityMapping + | tables space count | + space := self pageTableMappedSpace. + count := self pageTablesCount. + tables := OrderedCollection new: count. + 1 to: count do: [:i | + | table | table := PageTable entriesCount: self pageTableEntriesCount entrySize: self pageTableEntrySize. + table identityMappingStartingAt: (i - 1) * space pageSize: self pageSize. + tables add: table. + ]. + directory := PageDirectory entriesCount: count entrySize: 4 pageTables: tables. + +! ! + +!PageManager methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + handlers := Dictionary new. + pageHandled := Semaphore new. + interrupted := Semaphore new. + + + + +! ! + +!PageManager methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:24'! +installCallbackOn: aComputer + | callback | + pageFaultCallback := Callback block: [:args :result | "Project spawnNewProcessIfThisIsUICallback: Processor activeProcess" + pageHandled wait. + result returnInteger: 1] + argsClass: PageFaultParameters. + aComputer info pageFaultHandlerEntry: pageFaultCallback thunk address. + Computer primRegisterSemaphoreIndex: (Smalltalk registerExternalObject: interrupted) forIRQ: 15. + [[true] whileTrue: [ + interrupted wait. "this is activated by C glue code" + self resolvePageFaultOn: aComputer pageFaultAddress. + pageHandled signal] + ] forkAt: Processor highIOPriority + 1 +! ! + +!PageManager methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:24'! +installOn: aComputer + self installCallbackOn: aComputer. + processor enablePagingWithDirectory: directory externalAddress + + + +! ! + +!PageManager methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isPresentAndAllowed: anAddress + | table tableIndex | + table := self pageTableFor: anAddress. + tableIndex := self pageTableIndexFor: anAddress. + ^table isPresentAndAllowed: tableIndex +! ! + +!PageManager methodsFor: 'translation-private' stamp: 'KenD 28/Jun/2026 13:32:24'! +offsetFor: anAddress + ^anAddress bitAnd: 16r00000FFF. + +! ! + +!PageManager methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageDirectoryEntryFor: anAddress + | index | + index := self pageDirectoryIndexFor: anAddress. + ^directory entryFor: index +! ! + +!PageManager methodsFor: 'translation-private' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageDirectoryIndexFor: anAddress + | shifted trunced | + shifted := anAddress bitShift: -22. + trunced := shifted bitAnd: 16r000003FF. + ^trunced +! ! + +!PageManager methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageSize + ^4096 +! ! + +!PageManager methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageStartAddressOf: anAddress. + ^anAddress bitAnd: 16rFFFFF000 +! ! + +!PageManager methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTableEntriesCount + ^1024 +! ! + +!PageManager methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTableEntriesFor: anInterval + | startDirectoryIndex stopDirectoryIndex start end firstIndex lastIndex entries | + start := anInterval first. + end := anInterval last. + startDirectoryIndex := self pageDirectoryIndexFor: start. + stopDirectoryIndex := self pageDirectoryIndexFor: end. + entries := OrderedCollection new. + firstIndex := self pageTableIndexFor: start. + lastIndex := self pageTableIndexFor: end. + startDirectoryIndex = stopDirectoryIndex ifTrue: [ + entries addAll: ((directory pageTableAtIndex: startDirectoryIndex) entriesFromIndex: firstIndex to: lastIndex). + ] ifFalse: [ + entries addAll: ((directory pageTableAtIndex: startDirectoryIndex) entriesFromIndex: firstIndex); + addAll: ((directory pageTableAtIndex: stopDirectoryIndex) entriesUptoIndex: lastIndex). + startDirectoryIndex + 1 to: stopDirectoryIndex - 1 do: [:index | + entries addAll: (directory pageTableAtIndex: index) entries + ] + ]. + ^entries + + +! ! + +!PageManager methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTableEntryFor: anAddress + | table index | + table := self pageTableFor: anAddress. + index := self pageTableIndexFor: anAddress. + ^table entryFor: index +! ! + +!PageManager methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTableEntrySize + ^4 +! ! + +!PageManager methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTableFor: anAddress + | directoryIndex tableIndex | + directoryIndex := self pageDirectoryIndexFor: anAddress. + ^directory pageTableAtIndex: directoryIndex. + +! ! + +!PageManager methodsFor: 'translation-private' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTableIndexFor: anAddress + | shifted trunced | + shifted := anAddress bitShift: -12. + trunced := shifted bitAnd: 16r000003FF. + ^trunced +! ! + +!PageManager methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTableMappedSpace + ^self pageSize * self pageTableEntriesCount +! ! + +!PageManager methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTablesCount + | size space | + "size := self memory size." + size := 1024 * 1024 * 1024 * 4. + space := self pageTableMappedSpace. + ^(size / space) ceiling. + +! ! + +!PageManager methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +readOnly + directory readOnly +! ! + +!PageManager methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +readOnlyFrom: start to: end + (self pageTableEntriesFor: (start to: end)) do: [:entry | entry readOnly] +! ! + +!PageManager methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +readWriteFrom: start to: end + (self pageTableEntriesFor: (start to: end)) do: [:entry | entry readWrite] +! ! + +!PageManager methodsFor: 'page faults' stamp: 'KenD 28/Jun/2026 13:32:24'! +resolvePageFaultOn: anAddress + | handler | + handler := self handlerFor: anAddress. + handler resolvePageFaultOn: anAddress + +! ! + +!PageManager methodsFor: 'translation' stamp: 'KenD 28/Jun/2026 13:32:24'! +translate: anAddress + | directoryIndex tableIndex offset table address | + directoryIndex := self pageDirectoryIndexFor: anAddress. + tableIndex := self pageTableIndexFor: anAddress. + offset := self offsetFor: anAddress. + table := directory pageTableAtIndex: directoryIndex. + address := table phisicalAddressFor: tableIndex. + ^address + offset +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PageManager class' category: 'SqueakNOS-Memory-Manager'! +PageManager class + instanceVariableNames: ''! + + +PageManager initialize! + diff --git a/modules/NOS/MemoryManager/Paging/PageDirectory.Class.st b/modules/NOS/MemoryManager/Paging/PageDirectory.Class.st new file mode 100644 index 00000000..6f48917b --- /dev/null +++ b/modules/NOS/MemoryManager/Paging/PageDirectory.Class.st @@ -0,0 +1,86 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PageDirectory category: 'SqueakNOS-MemoryManager-Paging'! +PageIndex subclass: #PageDirectory + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-MemoryManager-Paging'! +!PageDirectory methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:32:24'! +deepCopy + | pageTables readOnlyTables | + pageTables := self pageTables. + readOnlyTables := OrderedCollection new: pageTables size. + pageTables do: [:table | readOnlyTables add: (PageTable fromTable: table)]. + ^self class entriesCount: self entriesCount entrySize: self entrySize pageTables: readOnlyTables +! ! + +!PageDirectory methodsFor: 'memory management' stamp: 'KenD 28/Jun/2026 13:32:24'! +free + self halt. + self entries do: [:entry | entry free]. + super free. +! ! + +!PageDirectory methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:24'! +initialize + super initialize. + "self entries withIndexDo: [:entry :index | entry clean. entry setPresentAndSupervisor]" +! ! + +!PageDirectory methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTableAtIndex: aNumber + | entry | + entry := self entryFor: aNumber. + ^entry isPresentAndAllowed ifTrue: [ | alien | + alien := Alien forPointer: entry pointedAddress. + PageTable handledBy: alien entriesCount: self entriesCount entrySize: self entrySize. + ] ifFalse: [(self error: 'PageFault')] +! ! + +!PageDirectory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTables + | records tables size entries | + tables := OrderedCollection new: self entriesCount. + 1 to: self entriesCount do: [:index | tables add: (self pageTableAtIndex: index - 1)]. + ^tables +! ! + +!PageDirectory methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTables: anOrderedCollection + (self entries first: anOrderedCollection size) withIndexDo: [:entry : index | entry pageFrame: (anOrderedCollection at: index) externalAddress; setPresentAndWritable] +! ! + +!PageDirectory methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + self entries withIndexDo: [ :entry :index | + aStream nextPutAll: 'Table ', index printString, ': ', entry printString; cr. + ] +! ! + +!PageDirectory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +readOnly + self pageTables do: [:pageTable | pageTable readOnly] +! ! + +!PageDirectory methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +readOnlyFrom: start to: end + | interval | + interval := start to: end. + self pageTables select: [:pageTable | interval rangeIncludes: pageTable ] thenDo: [:pageTable | pageTable readOnly] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PageDirectory class' category: 'SqueakNOS-MemoryManager-Paging'! +PageDirectory class + instanceVariableNames: ''! + +!PageDirectory class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +entriesCount: aNumber entrySize: anotherNumber pageTables: anOrderedCollection + ^(super entriesCount: aNumber entrySize: anotherNumber) pageTables: anOrderedCollection +! ! + + +PageDirectory initialize! + diff --git a/modules/NOS/MemoryManager/Paging/PageDirectoryRecord.Class.st b/modules/NOS/MemoryManager/Paging/PageDirectoryRecord.Class.st new file mode 100644 index 00000000..8ec6bb1a --- /dev/null +++ b/modules/NOS/MemoryManager/Paging/PageDirectoryRecord.Class.st @@ -0,0 +1,22 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PageDirectoryRecord category: 'SqueakNOS-MemoryManager-Paging'! +Alien subclass: #PageDirectoryRecord + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-MemoryManager-Paging'! +!PageDirectoryRecord methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:24'! +initializeSameAddresses + | i | + i := 1. + self records do: [:record | record address: i] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PageDirectoryRecord class' category: 'SqueakNOS-MemoryManager-Paging'! +PageDirectoryRecord class + instanceVariableNames: ''! + + diff --git a/modules/NOS/MemoryManager/Paging/PageFaultParameters.Class.st b/modules/NOS/MemoryManager/Paging/PageFaultParameters.Class.st new file mode 100644 index 00000000..fa11c233 --- /dev/null +++ b/modules/NOS/MemoryManager/Paging/PageFaultParameters.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PageFaultParameters category: 'SqueakNOS-MemoryManager-Paging'! +Alien subclass: #PageFaultParameters + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-MemoryManager-Paging'! +!PageFaultParameters methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:24'! +dataSize + ^4 +! ! + +!PageFaultParameters methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +virtualFaultAddress + ^self unsignedLongAt: 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PageFaultParameters class' category: 'SqueakNOS-MemoryManager-Paging'! +PageFaultParameters class + instanceVariableNames: ''! + + diff --git a/modules/NOS/MemoryManager/Paging/PageIndex.Class.st b/modules/NOS/MemoryManager/Paging/PageIndex.Class.st new file mode 100644 index 00000000..aead9046 --- /dev/null +++ b/modules/NOS/MemoryManager/Paging/PageIndex.Class.st @@ -0,0 +1,127 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PageIndex category: 'SqueakNOS-MemoryManager-Paging'! +Object subclass: #PageIndex + instanceVariableNames: 'handle entriesCount entrySize' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-MemoryManager-Paging'! +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +contents + | result | + result := ByteArray new: self entriesCount * self entrySize. + self handle copyInto: result from: 1 to: result size in: self handle startingAt: 1. + ^result +! ! + +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +contentsFrom: start to: stop + | result | + result := ByteArray new: stop - start + 1. + self handle copyInto: result from: 1 to: result size in: self handle startingAt: start. + ^result +! ! + +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +entries + | count entries | + count := self entriesCount. + entries := OrderedCollection new: count. + 0 to: count - 1 do: [:index | | record | + entries add: (self entryFor: index)]. + ^entries +! ! + +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +entriesCount + ^entriesCount +! ! + +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +entriesCount: aNumber + entriesCount := aNumber +! ! + +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +entriesFromIndex: start + | entries stop | + stop := self entriesCount. + entries := OrderedCollection new: stop - start + 1. + (start to: stop) do: [:index | entries add: (self entryFor: index)]. + ^entries +! ! + +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +entriesFromIndex: start to: stop + | entries | + entries := OrderedCollection new: stop - start + 1. + (start to: stop) do: [:index | entries add: (self entryFor: index)]. + ^entries +! ! + +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +entriesUptoIndex: stop + | entries | + entries := OrderedCollection new: stop. + (1 to: stop) do: [:index | entries add: (self entryFor: index)]. + ^entries +! ! + +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +entryFor: anIndex + | address handler | + address := self externalAddressFor: anIndex. + handler := Alien forPointer: address. + ^PageTableEntry handledBy: handler +! ! + +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +entrySize + ^entrySize +! ! + +!PageIndex methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +entrySize: aNumber + entrySize := aNumber +! ! + +!PageIndex methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +externalAddress + ^handle address +! ! + +!PageIndex methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +externalAddressFor: anIndex + ^self externalAddress + (self entrySize * anIndex) +! ! + +!PageIndex methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +handle + ^handle + +! ! + +!PageIndex methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +handle: anExternalHandler + handle := anExternalHandler +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PageIndex class' category: 'SqueakNOS-MemoryManager-Paging'! +PageIndex class + instanceVariableNames: ''! + +!PageIndex class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +entriesCount: aNumber entrySize: anotherNumber + | alien | + alien := (Alien newCPageAligned: aNumber * anotherNumber). + ^self handledBy: alien entriesCount: aNumber entrySize: anotherNumber +! ! + +!PageIndex class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +handledBy: externalHandle entriesCount: aNumber entrySize: anotherNumber + ^self new handle: externalHandle; entriesCount: aNumber; entrySize: anotherNumber +! ! + + diff --git a/modules/NOS/MemoryManager/Paging/PageTable.Class.st b/modules/NOS/MemoryManager/Paging/PageTable.Class.st new file mode 100644 index 00000000..b3c6a61e --- /dev/null +++ b/modules/NOS/MemoryManager/Paging/PageTable.Class.st @@ -0,0 +1,72 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PageTable category: 'SqueakNOS-MemoryManager-Paging'! +PageIndex subclass: #PageTable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-MemoryManager-Paging'! +!PageTable methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:32:24'! +deepCopy + | entries size count alien | + entries := self entriesCount. + size := self entrySize. + count := entries * size. + alien := Alien newCPageAligned: count. + alien copyInto: alien from: 1 to: count in: self handle startingAt: 1. + ^self class handledBy: alien entriesCount: entries entrySize: size +! ! + +!PageTable methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:24'! +identityMappingStartingAt: address pageSize: aNumber + self entries withIndexDo: [:entry :index | entry clean; setPresentAndWritable; pageFrame: (index - 1) * aNumber + address] + +! ! + +!PageTable methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isPresentAndAllowed: aNumber + | entry | + entry := self entryFor: aNumber. + ^entry isPresentAndAllowed +! ! + +!PageTable methodsFor: 'translation' stamp: 'KenD 28/Jun/2026 13:32:24'! +phisicalAddressFor: aNumber + | entry | + entry := self entryFor: aNumber. + ^entry pointedAddress +! ! + +!PageTable methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + self entries withIndexDo: [ :entry :index | + aStream nextPutAll: 'Page ', index printString, ': ', entry printString; cr. + ] +! ! + +!PageTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +readOnly + self entries do: [:entry | entry readOnly] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PageTable class' category: 'SqueakNOS-MemoryManager-Paging'! +PageTable class + instanceVariableNames: ''! + +!PageTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromTable: aPageTable + | count alien | + count := aPageTable entriesCount * aPageTable entrySize. + alien := Alien newCPageAligned: count. + alien copyInto: alien from: 1 to: count in: aPageTable handle startingAt: 1. + ^self handledBy: alien entriesCount: aPageTable entriesCount entrySize: aPageTable entrySize +! ! + +!PageTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:24'! +fromTable: aPageTable size: aNumber + ^(self newCPageAligned: aNumber) copyInto: self from: 0 to: aNumber - 1 in: aPageTable startingAt: 0 +! ! + + diff --git a/modules/NOS/MemoryManager/Paging/PageTableEntry.Class.st b/modules/NOS/MemoryManager/Paging/PageTableEntry.Class.st new file mode 100644 index 00000000..27f9fe0b --- /dev/null +++ b/modules/NOS/MemoryManager/Paging/PageTableEntry.Class.st @@ -0,0 +1,146 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PageTableEntry category: 'SqueakNOS-MemoryManager-Paging'! +Object subclass: #PageTableEntry + instanceVariableNames: 'handle' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-MemoryManager-Paging'! +!PageTableEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +clean + handle unsignedLongAt: 1 put: 0 +! ! + +!PageTableEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +handle: anExternalHandler + handle := anExternalHandler +! ! + +!PageTableEntry methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:24'! +handledBy: externalHandle + ^self new handle: externalHandle +! ! + +!PageTableEntry methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isPresent + | value | + value := handle unsignedLongAt: 1. + value := value bitAnd: 16r00000001. + ^value = 16r1 +! ! + +!PageTableEntry methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isPresentAndAllowed + | value | + value := handle unsignedLongAt: 1. + value := value bitAnd: 16r00000003. + ^value = 16r3 +! ! + +!PageTableEntry methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isPresentAndForbidden + | value | + value := handle unsignedLongAt: 1. + value := value bitAnd: 16r00000003. + ^value = 16r1 +! ! + +!PageTableEntry methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:24'! +isReadOnly + | value | + value := handle unsignedLongAt: 1. + value := value bitAnd: 16r00000010. + ^value = 16r2 +! ! + +!PageTableEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +notPresent + | value | + value := handle unsignedLongAt: 1. + value := value bitAt: 1 put: 0. + handle unsignedLongAt: 1 put: value +! ! + +!PageTableEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageFrame: aNumber + | value frame | + "aNumber must be page aligned" + value := handle unsignedLongAt: 1. + value := value bitAnd: 16r00000FFF. + value := value bitOr: aNumber. + handle unsignedLongAt: 1 put: value +! ! + +!PageTableEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +pageTable + | address | + address := self pointedAddress. + ^PageTable forPointer: address +! ! + +!PageTableEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +pointedAddress + | address | + address := handle unsignedLongAt: 1. + ^address bitAnd: 16rFFFFF000 +! ! + +!PageTableEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +presentAndWritableWord + ^16r00000003 + +! ! + +!PageTableEntry methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:24'! +printOn: aStream + aStream nextPutAll: 'Translates to: ', self pointedAddress printString, ', Status bits: ', self status printString. +! ! + +!PageTableEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +readOnly + | value | + "User mode needs to be set" + value := handle unsignedLongAt: 1. + value := value bitAt: 2 put: 0. + handle unsignedLongAt: 1 put: value + + + + +! ! + +!PageTableEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +readWrite + | value | + "User mode needs to be set" + value := handle unsignedLongAt: 1. + value := value bitAt: 2 put: 1. + handle unsignedLongAt: 1 put: value + + + + +! ! + +!PageTableEntry methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +setPresentAndWritable + | value | + value := handle unsignedLongAt: 1. + value := value bitOr: self presentAndWritableWord. + handle unsignedLongAt: 1 put: value +! ! + +!PageTableEntry methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +status + | value | + value := handle unsignedLongAt: 1. + ^value := value bitAnd: 16r00000FFF +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PageTableEntry class' category: 'SqueakNOS-MemoryManager-Paging'! +PageTableEntry class + instanceVariableNames: ''! + + diff --git a/modules/NOS/MemoryManager/PagingTest.Class.st b/modules/NOS/MemoryManager/PagingTest.Class.st new file mode 100644 index 00000000..809997e7 --- /dev/null +++ b/modules/NOS/MemoryManager/PagingTest.Class.st @@ -0,0 +1,70 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #PagingTest category: 'SqueakNOS-Memory-Manager'! +TestCase subclass: #PagingTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Memory-Manager'! +!PagingTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testCopyOnWriteHandling + | memory manager directory pte pageTable pageTableAfterFault pteAfterFault | + memory := Memory new size: 1048576. "1mb" + manager := PageManager forMemory: memory. + manager from: 0 to: 8192 useHandler: #copyOnWrite. + directory := manager directory. + pageTable := manager pageTableFor: 5000. + pte := manager pageTableEntryFor: 5000. + pte readOnly. + manager resolvePageFaultOn: 5000. + pageTableAfterFault := manager pageTableFor: 5000. + pteAfterFault := manager pageTableEntryFor: 5000. + self deny: pageTable externalAddress = pageTableAfterFault externalAddress; + assert: (pageTable contentsFrom: 1 to: 4) = (pageTableAfterFault contentsFrom: 1 to: 4); + assert: (pageTable contentsFrom: 9 to: 4096) = (pageTableAfterFault contentsFrom: 9 to: 4096); + assert: pteAfterFault isPresentAndAllowed +! ! + +!PagingTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testDirectoryCloning + | memory manager alienAddresses clone newAddresses | + [ + memory := Memory new size: 10485760. "10mb" + manager := PageManager forMemory: memory. + alienAddresses := manager directory entries collect: [:entry | entry pointedAddress]. + alienAddresses add: manager directory externalAddress. + clone := manager directory deepCopy. + manager directory: clone. + newAddresses := manager directory entries collect: [:entry | entry pointedAddress]. + self deny: (alienAddresses includes: manager directory externalAddress); + assert: (newAddresses noneSatisfy: [:address | alienAddresses includes: address]). + 16r0 to: 16rA00000 - 1 by: 1000 do: [:index | self assert: (manager translate: index) = index; assert: (manager isPresentAndAllowed: index)]. + ] ensure: ["clone free"] + +! ! + +!PagingTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testIdentityTranslation + | memory manager | + memory := Memory new size: 104857600. "100mb" + manager := PageManager forMemory: memory. + 16r0 to: 16r6400000 - 1 by: 413 do: [:index | self assert: (manager translate: index) = index; assert: (manager isPresentAndAllowed: index)]. +! ! + +!PagingTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:24'! +testPageIndexesPageAligned + | memory manager addresses | + memory := Memory new size: 200000000. "100mb" + manager := PageManager forMemory: memory. + addresses := manager directory entries collect: [:entry | entry pointedAddress]. + self assert: manager directory externalAddress \\ 4096 = 0; + assert: (addresses allSatisfy: [:address | address \\ 4096 = 0]) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PagingTest class' category: 'SqueakNOS-Memory-Manager'! +PagingTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Conduit/Conduit.Class.st b/modules/NOS/Network/Conduit/Conduit.Class.st new file mode 100644 index 00000000..09d497f5 --- /dev/null +++ b/modules/NOS/Network/Conduit/Conduit.Class.st @@ -0,0 +1,146 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #Conduit category: 'SqueakNOS-Net-Conduits'! +Object subclass: #Conduit + instanceVariableNames: 'left right timer' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Conduits'! +!Conduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +< aConduit + ^ aConduit left: self +! ! + +!Conduit methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +<< anObject + self output: anObject +! ! + +!Conduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +> aConduit + ^ self add: aConduit +! ! + +!Conduit methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ true +! ! + +!Conduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +add: aConduit + ^ right add: aConduit +! ! + +!Conduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +detach + self unschedule. + left remove: self +! ! + +!Conduit methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:32:25'! +do: aBlock + right do: aBlock +! ! + +!Conduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +findA: aClass + ^ self findA: aClass ifNone: [] +! ! + +!Conduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +findA: aClass ifNone: aBlock + | found | + (self isKindOf: aClass) ifTrue: [^ self]. + self do: [ :each | (found := each findA: aClass ifNone: []) ifNotNil: [^ found]]. + ^ aBlock value +! ! + +!Conduit methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + right := OrderedCollection new. + timer := ConduitTimer new +! ! + +!Conduit methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: anObject + | delivered | + anObject isNil ifTrue: [^ self]. + delivered := false. + self do: [ :each | + (each accepts: anObject) + ifTrue: [delivered := true. + each input: anObject]]. + delivered ifFalse: [self undeliverable: anObject] +! ! + +!Conduit methodsFor: 'accessing-private' stamp: 'KenD 28/Jun/2026 13:32:25'! +left: aConduit + left := aConduit +! ! + +!Conduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mtu + ^ (left ifNil: [^ 0]) mtu +! ! + +!Conduit methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +output: anObject + left << anObject +! ! + +!Conduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +remove: aConduit + ^ right remove: aConduit +! ! + +!Conduit methodsFor: 'timer' stamp: 'KenD 28/Jun/2026 13:32:25'! +schedule + ^ self +! ! + +!Conduit methodsFor: 'timer' stamp: 'KenD 28/Jun/2026 13:32:25'! +timer + ^ timer +! ! + +!Conduit methodsFor: 'timer' stamp: 'KenD 28/Jun/2026 13:32:25'! +timerDown + self unschedule. + timer down +! ! + +!Conduit methodsFor: 'timer' stamp: 'KenD 28/Jun/2026 13:32:25'! +timerUp + timer up. + self schedule +! ! + +!Conduit methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +undeliverable: anObject + ^ self "drop it" +! ! + +!Conduit methodsFor: 'timer' stamp: 'KenD 28/Jun/2026 13:32:25'! +unschedule + timer removeAlarmsFor: self +! ! + +!Conduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +| aConduit + ^ self > aConduit; < aConduit +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Conduit class' category: 'SqueakNOS-Net-Conduits'! +Conduit class + instanceVariableNames: ''! + +!Conduit class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^ super new initialize +! ! + + +Conduit initialize! + diff --git a/modules/NOS/Network/Conduit/ConduitAlarm.Class.st b/modules/NOS/Network/Conduit/ConduitAlarm.Class.st new file mode 100644 index 00000000..769ef306 --- /dev/null +++ b/modules/NOS/Network/Conduit/ConduitAlarm.Class.st @@ -0,0 +1,60 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ConduitAlarm category: 'SqueakNOS-Net-Conduits'! +MessageSend subclass: #ConduitAlarm + instanceVariableNames: 'scheduledTime stepTime numArgs' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Conduits'! +!ConduitAlarm methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +scheduledTime + ^ scheduledTime +! ! + +!ConduitAlarm methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +scheduledTime: time + scheduledTime := time +! ! + +!ConduitAlarm methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +stepTime + ^ stepTime +! ! + +!ConduitAlarm methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +stepTime: msecs + stepTime := msecs +! ! + +!ConduitAlarm methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:32:25'! +value: anArgument + | nArgs | + numArgs ifNil:[numArgs := selector numArgs]. + nArgs := arguments ifNil:[0] ifNotNil:[arguments size]. + nArgs = numArgs ifTrue:[ + "Ignore extra argument" + ^self value]. + ^arguments isNil + ifTrue: [receiver perform: selector with: anArgument] + ifFalse: [receiver perform: selector withArguments: (arguments copyWith: anArgument)] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ConduitAlarm class' category: 'SqueakNOS-Net-Conduits'! +ConduitAlarm class + instanceVariableNames: ''! + +!ConduitAlarm class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +scheduledAt: scheduledTime receiver: aTarget selector: aSelector arguments: argArray + ^ self scheduledAt: scheduledTime stepTime: nil receiver: aTarget selector: aSelector arguments: argArray +! ! + +!ConduitAlarm class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +scheduledAt: scheduledTime stepTime: msecsOrNil receiver: aTarget selector: aSelector arguments: argArray + ^(self receiver: aTarget selector: aSelector arguments: argArray) + scheduledTime: scheduledTime; + stepTime: msecsOrNil +! ! + + diff --git a/modules/NOS/Network/Conduit/ConduitTimer.Class.st b/modules/NOS/Network/Conduit/ConduitTimer.Class.st new file mode 100644 index 00000000..b79fceb4 --- /dev/null +++ b/modules/NOS/Network/Conduit/ConduitTimer.Class.st @@ -0,0 +1,192 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ConduitTimer category: 'SqueakNOS-Net-Conduits'! +Object subclass: #ConduitTimer + instanceVariableNames: 'process alarms' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Conduits'! +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +addAlarm: aConduitAlarm + Transcript cr; show: 'New alarm: ', aConduitAlarm printString. + alarms add: aConduitAlarm. + process isNil ifTrue: [self up]. + ^ aConduitAlarm +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +after: msecs send: aSelector to: anObject + self at: self time + msecs send: aSelector to: anObject +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +after: msecs send: aSelector to: anObject with: anArgument + self at: self time + msecs send: aSelector to: anObject with: anArgument +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +after: msecs send: aSelector to: anObject withArguments: anArray + self at: self time + msecs send: aSelector to: anObject withArguments: anArray +! ! + +!ConduitTimer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +alarmSortBlock + ^ [ :alarm1 :alarm2 | + | answer | + answer := alarm1 scheduledTime < alarm2 scheduledTime. + answer] +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: scheduledTime send: aSelector to: anObject + self addAlarm: + (ConduitAlarm + scheduledAt: scheduledTime + receiver: anObject + selector: aSelector + arguments: #()) +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: scheduledTime send: aSelector to: anObject with: anArgument + self addAlarm: + (ConduitAlarm + scheduledAt: scheduledTime + receiver: anObject + selector: aSelector + arguments: (Array with: anArgument)) +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: scheduledTime send: aSelector to: anObject withArguments: anArray + self addAlarm: + (ConduitAlarm + scheduledAt: scheduledTime + receiver: anObject + selector: aSelector + arguments: anArray) +! ! + +!ConduitTimer methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +down + process ifNotNil: [process terminate]. + process := nil +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +every: msecs send: aSelector to: anObject + self addAlarm: + (ConduitAlarm + scheduledAt: self time + stepTime: msecs + receiver: anObject + selector: aSelector + arguments: #()) +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +every: msecs send: aSelector to: anObject with: anArgument + self addAlarm: + (ConduitAlarm + scheduledAt: self time + stepTime: msecs + receiver: anObject + selector: aSelector + arguments: (Array with: anArgument)) +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +every: msecs send: aSelector to: anObject withArguments: anArray + self addAlarm: + (ConduitAlarm + scheduledAt: self time + stepTime: msecs + receiver: anObject + selector: aSelector + arguments: anArray) +! ! + +!ConduitTimer methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + alarms := self newAlarmsHeap +! ! + +!ConduitTimer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +loop + self triggerPendingAlarms. + self sleep +! ! + +!ConduitTimer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +newAlarmsHeap + ^ Heap sortBlock: self alarmSortBlock +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +removeAlarm: aSelector for: anObject + | oldAlarms | + oldAlarms := alarms. + alarms := self newAlarmsHeap. + oldAlarms do: [ :each | + (each receiver == anObject and: [each selector == aSelector]) + ifFalse: [alarms add: each]]. + alarms isEmpty ifTrue: [self down] +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +removeAlarmsFor: anObject + | oldAlarms | + oldAlarms := alarms. + alarms := self newAlarmsHeap. + oldAlarms do: [ :each | each receiver == anObject ifFalse: [alarms add: each]]. + alarms isEmpty ifTrue: [self down] +! ! + +!ConduitTimer methodsFor: 'world state' stamp: 'KenD 28/Jun/2026 13:32:25'! +sleep + | msecs | + alarms isEmpty + ifTrue: [msecs := 1000] + ifFalse: [msecs := alarms first scheduledTime - self time]. + msecs > 0 ifFalse: [^ self]. + (Delay forMilliseconds: (msecs min: 1000)) wait +! ! + +!ConduitTimer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +time + ^ Time millisecondClockValue +! ! + +!ConduitTimer methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +triggerPendingAlarms + "Trigger all pending alarms." + | alarm time | + time := self time. + [alarms isEmpty not and:[alarms first scheduledTime < time]] + whileTrue: [alarm := alarms removeFirst. + alarm value: time. + alarm stepTime notNil + ifTrue: [alarm scheduledTime: time + alarm stepTime. + alarms add: alarm]] +! ! + +!ConduitTimer methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +up + self down. + process := [[self loop] repeat] fork +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ConduitTimer class' category: 'SqueakNOS-Net-Conduits'! +ConduitTimer class + instanceVariableNames: ''! + +!ConduitTimer class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^ super new initialize +! ! + + +ConduitTimer initialize! + diff --git a/modules/NOS/Network/Conduit/InternalRawSocket.Class.st b/modules/NOS/Network/Conduit/InternalRawSocket.Class.st new file mode 100644 index 00000000..843fc2db --- /dev/null +++ b/modules/NOS/Network/Conduit/InternalRawSocket.Class.st @@ -0,0 +1,80 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #InternalRawSocket category: 'SqueakNOS-Net-Conduits'! +InternalSocket subclass: #InternalRawSocket + instanceVariableNames: 'inputQ inputStream' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Conduits'! +!InternalRawSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +dataAvailable + "Answer whether there is data available for reading." + ^ inputStream atEnd not or: [inputQ isEmpty not] +! ! + +!InternalRawSocket methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + inputStream := '' readStream. + inputQ := SharedQueue new +! ! + +!InternalRawSocket methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + inputQ nextPut: aPacket +! ! + +!InternalRawSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +next + ^ inputQ next +! ! + +!InternalRawSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +next: anInteger into: aByteArray startingAt: startIndex + "Read the next anInteger bytes into aByteArray, starting at startIndex. Answer the number of bytes actually read." + + self dataAvailable ifFalse: [^ 0]. + inputStream atEnd ifTrue: [inputStream _ self next rawDataStream]. + ^ (inputStream next: anInteger into: aByteArray startingAt: startIndex) size +! ! + +!InternalRawSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: aPacket + self << aPacket. + ^ aPacket +! ! + +!InternalRawSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextTimeoutMSecs: milliseconds + ^ inputQ nextTimeoutMSecs: milliseconds +! ! + +!InternalRawSocket methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +waitForReadabilityTimeoutAfter: timeoutInMilliseconds + "Wait for readable data, or until timeoutInMilliseconds pass, whichever comes first. -1 is special case wait for ever, also some callers pass zero" + + | deadLine aPacket | + timeoutInMilliseconds < 0 + ifTrue: [self dataAvailable ifTrue: [^ self]. + inputStream := inputQ next rawDataStream. + ^ self]. + + deadLine := Time millisecondClockValue + timeoutInMilliseconds. + timedOut := false. + self dataAvailable ifTrue: [^ self]. + aPacket := self nextTimeoutMSecs: timeoutInMilliseconds. + aPacket isNil ifFalse: [inputStream := aPacket rawDataStream]. + self dataAvailable + ifFalse: [(deadLine - Time millisecondClockValue - 1) < 0 ifTrue: [timedOut := true]. + TimedOut new signal] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InternalRawSocket class' category: 'SqueakNOS-Net-Conduits'! +InternalRawSocket class + instanceVariableNames: ''! + + +InternalRawSocket initialize! + diff --git a/modules/NOS/Network/Conduit/InternalSocket.Class.st b/modules/NOS/Network/Conduit/InternalSocket.Class.st new file mode 100644 index 00000000..25e4056f --- /dev/null +++ b/modules/NOS/Network/Conduit/InternalSocket.Class.st @@ -0,0 +1,158 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #InternalSocket category: 'SqueakNOS-Net-Conduits'! +Conduit subclass: #InternalSocket + instanceVariableNames: 'timedOut' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Conduits'! +!InternalSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +abort + "Close immediatly. Don't try to send any queued data." + self close +! ! + +!InternalSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + "Close myself." + + ^ self +! ! + +!InternalSocket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +dataAvailable + "Answer whether there is data available for reading." + ^ self subclassResponsibility +! ! + +!InternalSocket methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + timedOut := false +! ! + +!InternalSocket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isActive + "Answer whether I'm active. In general, active means both myself and my peer(s) consider there to be a connection." + + ^self isOpen +! ! + +!InternalSocket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isConnected + "Return true if this socket is connected." + ^ true +! ! + +!InternalSocket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isOpen + "Answer whether I'm open. In general, open means that I consider there to be a connection with my peer(s), but it/they may not necessarily agree." + + ^ true +! ! + +!InternalSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +next + ^ self subclassResponsibility +! ! + +!InternalSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +next: anInteger into: aByteArray startingAt: startIndex + "Read the next anInteger bytes into aByteArray, starting at startIndex. Answer the number of bytes actually read." + + ^ self subclassResponsibility +! ! + +!InternalSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: aPacket + ^ self subclassResponsibility +! ! + +!InternalSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: anInteger from: aByteArray startingAt: startIndex + "Write the next anInteger elements in aByteArray, starting at startIndex. Answer the number of bytes actually written." + + ^ self subclassResponsibility +! ! + +!InternalSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextTimeoutMSecs: milliseconds + ^ self subclassResponsibility +! ! + +!InternalSocket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +peerClosed + "Answer whether my peer closed the connection." + "This is only possible for ClientTCPSockets." + + ^false +! ! + +!InternalSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +reopen + "Reopen myself." + + ^ self +! ! + +!InternalSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +restart + "Restart myself, if I was active." + + self isActive ifTrue: [self reopen] +! ! + +!InternalSocket methodsFor: 'timer' stamp: 'KenD 28/Jun/2026 13:32:25'! +scheduleDetachAfter: msecs + timer removeAlarm: #detach for: self. + timer after: msecs send: #detach to: self +! ! + +!InternalSocket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +scribes + "Answer whether I read or write (as opposed to accept)." + + ^true +! ! + +!InternalSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +setOption: aName value: aValue + "setup options on this socket, see Unix man pages for values for + sockets, IP, TCP, UDP. IE SO_KEEPALIVE + returns an array, element one is the error number + element two is the resulting of the negotiated value. + See getOption for list of keys" + + self error: 'Not implemented' +! ! + +!InternalSocket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +timedOut + "Answer whether I missed a deadline in my most recent wait." + + ^ timedOut +! ! + +!InternalSocket methodsFor: 'waiting' stamp: 'KenD 28/Jun/2026 13:32:25'! +waitForReadabilityTimeoutAfter: timeoutInMilliseconds + "Wait for readable data, or until timeoutInMilliseconds pass, whichever comes first. -1 is special case wait for ever, also some callers pass zero" + + ^ self subclassResponsibility +! ! + +!InternalSocket methodsFor: 'waiting' stamp: 'KenD 28/Jun/2026 13:32:25'! +waitForWriteability + "Wait for writing space." + "Writing space is typically in bountiful supply, so timeouts are effectively never necessary." + ^ self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InternalSocket class' category: 'SqueakNOS-Net-Conduits'! +InternalSocket class + instanceVariableNames: ''! + + +InternalSocket initialize! + diff --git a/modules/NOS/Network/Exceptions/ConnectionRefused.Class.st b/modules/NOS/Network/Exceptions/ConnectionRefused.Class.st new file mode 100644 index 00000000..cf8cd8a0 --- /dev/null +++ b/modules/NOS/Network/Exceptions/ConnectionRefused.Class.st @@ -0,0 +1,45 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ConnectionRefused category: 'SqueakNOS-Net-Exceptions'! +Error subclass: #ConnectionRefused + instanceVariableNames: 'host port' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Exceptions'! +!ConnectionRefused commentStamp: '' prior: 0! + +Signals that a connection to the specified host and port was refused. + + host host which refused the connection + port port to which the connection was refused + +! + +!ConnectionRefused methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +host + ^ host +! ! + +!ConnectionRefused methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +host: addressOrHostName port: portNumber + host := addressOrHostName. + port := portNumber +! ! + +!ConnectionRefused methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +port + ^ port +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ConnectionRefused class' category: 'SqueakNOS-Net-Exceptions'! +ConnectionRefused class + instanceVariableNames: ''! + +!ConnectionRefused class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +host: addressOrHostName port: portNumber + ^ self new host: addressOrHostName port: portNumber +! ! + + diff --git a/modules/NOS/Network/Exceptions/ConnectionReset.Class.st b/modules/NOS/Network/Exceptions/ConnectionReset.Class.st new file mode 100644 index 00000000..f3963cc1 --- /dev/null +++ b/modules/NOS/Network/Exceptions/ConnectionReset.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ConnectionReset category: 'SqueakNOS-Net-Exceptions'! +Error subclass: #ConnectionReset + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Exceptions'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ConnectionReset class' category: 'SqueakNOS-Net-Exceptions'! +ConnectionReset class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Exceptions/HostDown.Class.st b/modules/NOS/Network/Exceptions/HostDown.Class.st new file mode 100644 index 00000000..9f00808d --- /dev/null +++ b/modules/NOS/Network/Exceptions/HostDown.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #HostDown category: 'SqueakNOS-Net-Exceptions'! +Error subclass: #HostDown + instanceVariableNames: 'address' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Exceptions'! +!HostDown methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address + ^ address +! ! + +!HostDown methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address: aNetAddress + address := aNetAddress +! ! + +!HostDown methodsFor: 'description' stamp: 'KenD 28/Jun/2026 13:32:25'! +isResumable + ^ true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'HostDown class' category: 'SqueakNOS-Net-Exceptions'! +HostDown class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Exceptions/NetDown.Class.st b/modules/NOS/Network/Exceptions/NetDown.Class.st new file mode 100644 index 00000000..b83a51a9 --- /dev/null +++ b/modules/NOS/Network/Exceptions/NetDown.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NetDown category: 'SqueakNOS-Net-Exceptions'! +Error subclass: #NetDown + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Exceptions'! +!NetDown methodsFor: 'description' stamp: 'KenD 28/Jun/2026 13:32:25'! +isResumable + ^ true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NetDown class' category: 'SqueakNOS-Net-Exceptions'! +NetDown class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Exceptions/OutOfBandData.Class.st b/modules/NOS/Network/Exceptions/OutOfBandData.Class.st new file mode 100644 index 00000000..d7019e6e --- /dev/null +++ b/modules/NOS/Network/Exceptions/OutOfBandData.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #OutOfBandData category: 'SqueakNOS-Net-Exceptions'! +Notification subclass: #OutOfBandData + instanceVariableNames: 'data' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Exceptions'! +!OutOfBandData methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +data + ^ data +! ! + +!OutOfBandData methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +data: anObject + data := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OutOfBandData class' category: 'SqueakNOS-Net-Exceptions'! +OutOfBandData class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Interfaces/IPInterface.Class.st b/modules/NOS/Network/Interfaces/IPInterface.Class.st new file mode 100644 index 00000000..ff039b1e --- /dev/null +++ b/modules/NOS/Network/Interfaces/IPInterface.Class.st @@ -0,0 +1,36 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPInterface category: 'SqueakNOS-Net-Interfaces'! +NetInterface subclass: #IPInterface + instanceVariableNames: 'ip' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Interfaces'! +!IPInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + ip := IP new. + ip | TCP new. + ip | UDP new. + self | ip +! ! + +!IPInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +internetAddress: anInternetAddress + ip address: anInternetAddress +! ! + +!IPInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +ip + ^ ip +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPInterface class' category: 'SqueakNOS-Net-Interfaces'! +IPInterface class + instanceVariableNames: ''! + + +IPInterface initialize! + diff --git a/modules/NOS/Network/Interfaces/NetInterface.Class.st b/modules/NOS/Network/Interfaces/NetInterface.Class.st new file mode 100644 index 00000000..0b2ee2bd --- /dev/null +++ b/modules/NOS/Network/Interfaces/NetInterface.Class.st @@ -0,0 +1,107 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NetInterface category: 'SqueakNOS-Net-Interfaces'! +Conduit subclass: #NetInterface + instanceVariableNames: 'inputQ process device' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Interfaces'! +!NetInterface methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +device + ^ device +! ! + +!NetInterface methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +device: aNetworkDevice + device := aNetworkDevice +! ! + +!NetInterface methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +down + device down. + device removeActionsWithReceiver: self. + process ifNotNil: [process terminate. process := nil] +! ! + +!NetInterface methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +flush + "Discard all packets on the interface queue." + [inputQ isEmpty] whileFalse: [inputQ next] +! ! + +!NetInterface methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +handleInputPacket: aPacket + inputQ size > 100 ifTrue: [^ self error: 'Packet dropped']. + inputQ nextPut: aPacket +! ! + +!NetInterface methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + inputQ := SharedQueue new +! ! + +!NetInterface methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isDown + ^ self isUp not +! ! + +!NetInterface methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isUp + ^ process notNil +! ! + +!NetInterface methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +left: aConduit + ^ self shouldNotImplement +! ! + +!NetInterface methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mtu + ^ device mtu +! ! + +!NetInterface methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mtu: anInteger + device mtu: anInteger +! ! + +!NetInterface methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +output: aPacket + self isDown ifTrue: [^ NetDown signal]. + device output: aPacket +! ! + +!NetInterface methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +processLoop + self input: inputQ next +! ! + +!NetInterface methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +up + self down. + process := [[process isNil] whileFalse: [self processLoop]] newProcess. + device when: #input: send: #handleInputPacket: to: self. + device up. + process resume +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NetInterface class' category: 'SqueakNOS-Net-Interfaces'! +NetInterface class + instanceVariableNames: ''! + +!NetInterface class methodsFor: 'examples' stamp: 'KenD 28/Jun/2026 13:32:25'! +loopback + ^ self on: Loopback new +! ! + +!NetInterface class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aNetworkDevice + ^ self new device: aNetworkDevice +! ! + + +NetInterface initialize! + diff --git a/modules/NOS/Network/Missing/Ping.Class.st b/modules/NOS/Network/Missing/Ping.Class.st new file mode 100644 index 00000000..e8f3c909 --- /dev/null +++ b/modules/NOS/Network/Missing/Ping.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #Ping category: 'SqueakNOS-Net-MissingClass'! +Object subclass: #Ping + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-MissingClass'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Ping class' category: 'SqueakNOS-Net-MissingClass'! +Ping class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Missing/TCPSynScanner.Class.st b/modules/NOS/Network/Missing/TCPSynScanner.Class.st new file mode 100644 index 00000000..7cf0173d --- /dev/null +++ b/modules/NOS/Network/Missing/TCPSynScanner.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPSynScanner category: 'SqueakNOS-Net-MissingClass'! +Object subclass: #TCPSynScanner + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-MissingClass'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPSynScanner class' category: 'SqueakNOS-Net-MissingClass'! +TCPSynScanner class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Missing/TraceRoute.Class.st b/modules/NOS/Network/Missing/TraceRoute.Class.st new file mode 100644 index 00000000..626bd3e9 --- /dev/null +++ b/modules/NOS/Network/Missing/TraceRoute.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TraceRoute category: 'SqueakNOS-Net-MissingClass'! +Object subclass: #TraceRoute + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-MissingClass'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TraceRoute class' category: 'SqueakNOS-Net-MissingClass'! +TraceRoute class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Options/IP/IPOption.Class.st b/modules/NOS/Network/Options/IP/IPOption.Class.st new file mode 100644 index 00000000..2cffcf2b --- /dev/null +++ b/modules/NOS/Network/Options/IP/IPOption.Class.st @@ -0,0 +1,501 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPOption category: 'SqueakNOS-Net-Options-IP'! +Object subclass: #IPOption + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Options-IP'! +!IPOption commentStamp: '' prior: 0! + +Options: variable + + The options may appear or not in datagrams. They must be + implemented by all IP modules (host and gateways). What is optional + is their transmission in any particular datagram, not their + implementation. + + In some environments the security option may be required in all + datagrams. + + The option field is variable in length. There may be zero or more + options. There are two cases for the format of an option: + + Case 1: A single octet of option-type. + + Case 2: An option-type octet, an option-length octet, and the + actual option-data octets. + + The option-length octet counts the option-type octet and the + option-length octet as well as the option-data octets. + + The option-type octet is viewed as having 3 fields: + + 1 bit copied flag, + 2 bits option class, + 5 bits option number. + + The copied flag indicates that this option is copied into all + fragments on fragmentation. + + 0 = not copied + 1 = copied + + The option classes are: + + 0 = control + 1 = reserved for future use + 2 = debugging and measurement + 3 = reserved for future use + + [Page 15] + + September 1981 +Internet Protocol +Specification + + The following internet options are defined: + + CLASS NUMBER LENGTH DESCRIPTION + ----- ------ ------ ----------- + 0 0 - End of Option list. This option occupies only + 1 octet; it has no length octet. + 0 1 - No Operation. This option occupies only 1 + octet; it has no length octet. + 0 2 11 Security. Used to carry Security, + Compartmentation, User Group (TCC), and + Handling Restriction Codes compatible with DOD + requirements. + 0 3 var. Loose Source Routing. Used to route the + internet datagram based on information + supplied by the source. + 0 9 var. Strict Source Routing. Used to route the + internet datagram based on information + supplied by the source. + 0 7 var. Record Route. Used to trace the route an + internet datagram takes. + 0 8 4 Stream ID. Used to carry the stream + identifier. + 2 4 var. Internet Timestamp. + + Specific Option Definitions + + End of Option List + + +--------+ + |00000000| + +--------+ + Type=0 + + This option indicates the end of the option list. This might + not coincide with the end of the internet header according to + the internet header length. This is used at the end of all + options, not the end of each option, and need only be used if + the end of the options would not otherwise coincide with the end + of the internet header. + + May be copied, introduced, or deleted on fragmentation, or for + any other reason. + +[Page 16] + +September 1981 + Internet Protocol + Specification + + No Operation + + +--------+ + |00000001| + +--------+ + Type=1 + + This option may be used between options, for example, to align + the beginning of a subsequent option on a 32 bit boundary. + + May be copied, introduced, or deleted on fragmentation, or for + any other reason. + + Security + + This option provides a way for hosts to send security, + compartmentation, handling restrictions, and TCC (closed user + group) parameters. The format for this option is as follows: + + +--------+--------+---//---+---//---+---//---+---//---+ + |10000010|00001011|SSS SSS|CCC CCC|HHH HHH| TCC | + +--------+--------+---//---+---//---+---//---+---//---+ + Type=130 Length=11 + + Security (S field): 16 bits + + Specifies one of 16 levels of security (eight of which are + reserved for future use). + + 00000000 00000000 - Unclassified + 11110001 00110101 - Confidential + 01111000 10011010 - EFTO + 10111100 01001101 - MMMM + 01011110 00100110 - PROG + 10101111 00010011 - Restricted + 11010111 10001000 - Secret + 01101011 11000101 - Top Secret + 00110101 11100010 - (Reserved for future use) + 10011010 11110001 - (Reserved for future use) + 01001101 01111000 - (Reserved for future use) + 00100100 10111101 - (Reserved for future use) + 00010011 01011110 - (Reserved for future use) + 10001001 10101111 - (Reserved for future use) + 11000100 11010110 - (Reserved for future use) + 11100010 01101011 - (Reserved for future use) + + [Page 17] + + September 1981 +Internet Protocol +Specification + + Compartments (C field): 16 bits + + An all zero value is used when the information transmitted is + not compartmented. Other values for the compartments field + may be obtained from the Defense Intelligence Agency. + + Handling Restrictions (H field): 16 bits + + The values for the control and release markings are + alphanumeric digraphs and are defined in the Defense + Intelligence Agency Manual DIAM 65-19, "Standard Security + Markings". + + Transmission Control Code (TCC field): 24 bits + + Provides a means to segregate traffic and define controlled + communities of interest among subscribers. The TCC values are + trigraphs, and are available from HQ DCA Code 530. + + Must be copied on fragmentation. This option appears at most + once in a datagram. + + Loose Source and Record Route + + +--------+--------+--------+---------//--------+ + |10000011| length | pointer| route data | + +--------+--------+--------+---------//--------+ + Type=131 + + The loose source and record route (LSRR) option provides a means + for the source of an internet datagram to supply routing + information to be used by the gateways in forwarding the + datagram to the destination, and to record the route + information. + + The option begins with the option type code. The second octet + is the option length which includes the option type code and the + length octet, the pointer octet, and length-3 octets of route + data. The third octet is the pointer into the route data + indicating the octet which begins the next source address to be + processed. The pointer is relative to this option, and the + smallest legal value for the pointer is 4. + + A route data is composed of a series of internet addresses. + Each internet address is 32 bits or 4 octets. If the pointer is + greater than the length, the source route is empty (and the + recorded route full) and the routing is to be based on the + destination address field. + +[Page 18] + +September 1981 + Internet Protocol + Specification + + If the address in destination address field has been reached and + the pointer is not greater than the length, the next address in + the source route replaces the address in the destination address + field, and the recorded route address replaces the source + address just used, and pointer is increased by four. + + The recorded route address is the internet module's own internet + address as known in the environment into which this datagram is + being forwarded. + + This procedure of replacing the source route with the recorded + route (though it is in the reverse of the order it must be in to + be used as a source route) means the option (and the IP header + as a whole) remains a constant length as the datagram progresses + through the internet. + + This option is a loose source route because the gateway or host + IP is allowed to use any route of any number of other + intermediate gateways to reach the next address in the route. + + Must be copied on fragmentation. Appears at most once in a + datagram. + + Strict Source and Record Route + + +--------+--------+--------+---------//--------+ + |10001001| length | pointer| route data | + +--------+--------+--------+---------//--------+ + Type=137 + + The strict source and record route (SSRR) option provides a + means for the source of an internet datagram to supply routing + information to be used by the gateways in forwarding the + datagram to the destination, and to record the route + information. + + The option begins with the option type code. The second octet + is the option length which includes the option type code and the + length octet, the pointer octet, and length-3 octets of route + data. The third octet is the pointer into the route data + indicating the octet which begins the next source address to be + processed. The pointer is relative to this option, and the + smallest legal value for the pointer is 4. + + A route data is composed of a series of internet addresses. + Each internet address is 32 bits or 4 octets. If the pointer is + greater than the length, the source route is empty (and the + + [Page 19] + + September 1981 +Internet Protocol +Specification + + recorded route full) and the routing is to be based on the + destination address field. + + If the address in destination address field has been reached and + the pointer is not greater than the length, the next address in + the source route replaces the address in the destination address + field, and the recorded route address replaces the source + address just used, and pointer is increased by four. + + The recorded route address is the internet module's own internet + address as known in the environment into which this datagram is + being forwarded. + + This procedure of replacing the source route with the recorded + route (though it is in the reverse of the order it must be in to + be used as a source route) means the option (and the IP header + as a whole) remains a constant length as the datagram progresses + through the internet. + + This option is a strict source route because the gateway or host + IP must send the datagram directly to the next address in the + source route through only the directly connected network + indicated in the next address to reach the next gateway or host + specified in the route. + + Must be copied on fragmentation. Appears at most once in a + datagram. + + Record Route + + +--------+--------+--------+---------//--------+ + |00000111| length | pointer| route data | + +--------+--------+--------+---------//--------+ + Type=7 + + The record route option provides a means to record the route of + an internet datagram. + + The option begins with the option type code. The second octet + is the option length which includes the option type code and the + length octet, the pointer octet, and length-3 octets of route + data. The third octet is the pointer into the route data + indicating the octet which begins the next area to store a route + address. The pointer is relative to this option, and the + smallest legal value for the pointer is 4. + + A recorded route is composed of a series of internet addresses. + Each internet address is 32 bits or 4 octets. If the pointer is + +[Page 20] + +September 1981 + Internet Protocol + Specification + + greater than the length, the recorded route data area is full. + The originating host must compose this option with a large + enough route data area to hold all the address expected. The + size of the option does not change due to adding addresses. The + intitial contents of the route data area must be zero. + + When an internet module routes a datagram it checks to see if + the record route option is present. If it is, it inserts its + own internet address as known in the environment into which this + datagram is being forwarded into the recorded route begining at + the octet indicated by the pointer, and increments the pointer + by four. + + If the route data area is already full (the pointer exceeds the + length) the datagram is forwarded without inserting the address + into the recorded route. If there is some room but not enough + room for a full address to be inserted, the original datagram is + considered to be in error and is discarded. In either case an + ICMP parameter problem message may be sent to the source + host [3]. + + Not copied on fragmentation, goes in first fragment only. + Appears at most once in a datagram. + + Stream Identifier + + +--------+--------+--------+--------+ + |10001000|00000010| Stream ID | + +--------+--------+--------+--------+ + Type=136 Length=4 + + This option provides a way for the 16-bit SATNET stream + identifier to be carried through networks that do not support + the stream concept. + + Must be copied on fragmentation. Appears at most once in a + datagram. + + [Page 21] + + September 1981 +Internet Protocol +Specification + + Internet Timestamp + + +--------+--------+--------+--------+ + |01000100| length | pointer|oflw|flg| + +--------+--------+--------+--------+ + | internet address | + +--------+--------+--------+--------+ + | timestamp | + +--------+--------+--------+--------+ + | . | + . + . + Type = 68 + + The Option Length is the number of octets in the option counting + the type, length, pointer, and overflow/flag octets (maximum + length 40). + + The Pointer is the number of octets from the beginning of this + option to the end of timestamps plus one (i.e., it points to the + octet beginning the space for next timestamp). The smallest + legal value is 5. The timestamp area is full when the pointer + is greater than the length. + + The Overflow (oflw) [4 bits] is the number of IP modules that + cannot register timestamps due to lack of space. + + The Flag (flg) [4 bits] values are + + 0 -- time stamps only, stored in consecutive 32-bit words, + + 1 -- each timestamp is preceded with internet address of the + registering entity, + + 3 -- the internet address fields are prespecified. An IP + module only registers its timestamp if it matches its own + address with the next specified internet address. + + The Timestamp is a right-justified, 32-bit timestamp in + milliseconds since midnight UT. If the time is not available in + milliseconds or cannot be provided with respect to midnight UT + then any time may be inserted as a timestamp provided the high + order bit of the timestamp field is set to one to indicate the + use of a non-standard value. + + The originating host must compose this option with a large + enough timestamp data area to hold all the timestamp information + expected. The size of the option does not change due to adding + +[Page 22] + +September 1981 + Internet Protocol + Specification + + timestamps. The intitial contents of the timestamp data area + must be zero or internet address/zero pairs. + + If the timestamp data area is already full (the pointer exceeds + the length) the datagram is forwarded without inserting the + timestamp, but the overflow count is incremented by one. + + If there is some room but not enough room for a full timestamp + to be inserted, or the overflow count itself overflows, the + original datagram is considered to be in error and is discarded. + In either case an ICMP parameter problem message may be sent to + the source host [3]. + + The timestamp option is not copied upon fragmentation. It is + carried in the first fragment. Appears at most once in a + datagram. + + Padding: variable + + The internet header padding is used to ensure that the internet + header ends on a 32 bit boundary. The padding is zero. + +! + +!IPOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +classification + ^ (self type bitShift: -1) bitAnd: 2r11 +! ! + +!IPOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +copied + "Answer true if this option should be copied on all + fragments when doing IP fragmentation." + ^ self type odd +! ! + +!IPOption methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isEOL + "Answer true if this is a End of Options List." + ^ self type = 0 +! ! + +!IPOption methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isNOP + "Answer true if this is a No Operation." + ^ self type = 1 +! ! + +!IPOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + self isEOL ifTrue: [^ 'End']. + self isNOP ifTrue: [^ 'Noop']. + ^ super name +! ! + +!IPOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +number + ^ self type bitAnd: 2r11111 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPOption class' category: 'SqueakNOS-Net-Options-IP'! +IPOption class + instanceVariableNames: ''! + +!IPOption class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray offset: anInteger + | type | + type := aByteArray at: anInteger + 1. + self allSubclassesDo: [ :each | + type = each type ifTrue: [^ each new bytes: aByteArray; offset: anInteger]]. + ^ super bytes: aByteArray offset: anInteger +! ! + +!IPOption class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ nil +! ! + + diff --git a/modules/NOS/Network/Options/IP/IPTimestamp.Class.st b/modules/NOS/Network/Options/IP/IPTimestamp.Class.st new file mode 100644 index 00000000..ea8d0e93 --- /dev/null +++ b/modules/NOS/Network/Options/IP/IPTimestamp.Class.st @@ -0,0 +1,85 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPTimestamp category: 'SqueakNOS-Net-Options-IP'! +IPOption subclass: #IPTimestamp + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Options-IP'! +!IPTimestamp methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:32:25'! +add: anInteger + | timestampBytes | + self length - 4 > self pointer ifFalse: [^ self]. + timestampBytes := (BitArray new: 4*8 with: anInteger) asByteArray. + 1 to: 4 do: [ :each | self at: self pointer + each - 1 put: (timestampBytes at: each)]. + self pointer: self pointer + 4. + ^ anInteger +! ! + +!IPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +flags + ^ self at: 5 +! ! + +!IPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +flags: anInteger + self at: 5 put: anInteger +! ! + +!IPTimestamp methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isPrespecified + ^ self flags = 3 +! ! + +!IPTimestamp methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isTimestampsAndAddresses + ^ self flags = 1 +! ! + +!IPTimestamp methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isTimestampsOnly + ^ self flags = 0 +! ! + +!IPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + ^ 'timestamp' +! ! + +!IPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +overflow + ^ self at: 4 +! ! + +!IPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +overflow: anInteger + self at: 4 put: anInteger +! ! + +!IPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pointer + ^ self at: 3 +! ! + +!IPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pointer: anInteger + self at: 3 put: anInteger +! ! + +!IPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +timestamps + ^ (4 to: self pointer by: 4) collect: [ :each | (BitArray bytes: (self copyFrom: each to: each + 4)) asInteger] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPTimestamp class' category: 'SqueakNOS-Net-Options-IP'! +IPTimestamp class + instanceVariableNames: ''! + +!IPTimestamp class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ 68 +! ! + + diff --git a/modules/NOS/Network/Options/IP/LSRR.Class.st b/modules/NOS/Network/Options/IP/LSRR.Class.st new file mode 100644 index 00000000..3043d6dc --- /dev/null +++ b/modules/NOS/Network/Options/IP/LSRR.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #LSRR category: 'SqueakNOS-Net-Options-IP'! +RecordRoute subclass: #LSRR + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Options-IP'! +!LSRR methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + ^ 'LSRR' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LSRR class' category: 'SqueakNOS-Net-Options-IP'! +LSRR class + instanceVariableNames: ''! + +!LSRR class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ 131 +! ! + + diff --git a/modules/NOS/Network/Options/IP/RecordRoute.Class.st b/modules/NOS/Network/Options/IP/RecordRoute.Class.st new file mode 100644 index 00000000..1db76d84 --- /dev/null +++ b/modules/NOS/Network/Options/IP/RecordRoute.Class.st @@ -0,0 +1,48 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #RecordRoute category: 'SqueakNOS-Net-Options-IP'! +IPOption subclass: #RecordRoute + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Options-IP'! +!RecordRoute methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +add: anInternetAddress + self length - 4 > self pointer ifFalse: [^ self]. + 1 to: 4 do: [ :each | self at: self pointer + each - 1 put: (anInternetAddress at: each)]. + self pointer: self pointer + 4. + ^ anInternetAddress +! ! + +!RecordRoute methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +addresses + ^ (4 to: self pointer by: 4) collect: [ :each | InternetAddress bytes: (self copyFrom: each to: each + 4)] +! ! + +!RecordRoute methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + ^ 'RecordRoute' +! ! + +!RecordRoute methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pointer + ^ self at: 3 +! ! + +!RecordRoute methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pointer: anInteger + self at: 3 put: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RecordRoute class' category: 'SqueakNOS-Net-Options-IP'! +RecordRoute class + instanceVariableNames: ''! + +!RecordRoute class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ 7 +! ! + + diff --git a/modules/NOS/Network/Options/IP/SSRR.Class.st b/modules/NOS/Network/Options/IP/SSRR.Class.st new file mode 100644 index 00000000..e300a0b9 --- /dev/null +++ b/modules/NOS/Network/Options/IP/SSRR.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #SSRR category: 'SqueakNOS-Net-Options-IP'! +RecordRoute subclass: #SSRR + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Options-IP'! +!SSRR methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + ^ 'SSRR' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SSRR class' category: 'SqueakNOS-Net-Options-IP'! +SSRR class + instanceVariableNames: ''! + +!SSRR class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ 137 +! ! + + diff --git a/modules/NOS/Network/Options/TCP/MSS.Class.st b/modules/NOS/Network/Options/TCP/MSS.Class.st new file mode 100644 index 00000000..c81baad1 --- /dev/null +++ b/modules/NOS/Network/Options/TCP/MSS.Class.st @@ -0,0 +1,40 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #MSS category: 'SqueakNOS-Net-Options-TCP'! +TCPOption subclass: #MSS + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Options-TCP'! +!MSS methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: '{MSS='; print: self value; nextPut: $} +! ! + +!MSS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +value + ^ self shortAt: 3 +! ! + +!MSS methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +value: anInteger + self shortAt: 3 put: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MSS class' category: 'SqueakNOS-Net-Options-TCP'! +MSS class + instanceVariableNames: ''! + +!MSS class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + ^ 4 +! ! + +!MSS class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ 2 +! ! + + diff --git a/modules/NOS/Network/Options/TCP/SACK.Class.st b/modules/NOS/Network/Options/TCP/SACK.Class.st new file mode 100644 index 00000000..c9a93448 --- /dev/null +++ b/modules/NOS/Network/Options/TCP/SACK.Class.st @@ -0,0 +1,63 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #SACK category: 'SqueakNOS-Net-Options-TCP'! +TCPOption subclass: #SACK + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Options-TCP'! +!SACK methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockAt: anInteger + | firstIndex | + firstIndex := anInteger - 1 * 8 + 2 + 1. + ^ Interval + from: (TCPSequenceNumber value: (self longAt: firstIndex)) + to: (TCPSequenceNumber value: (self longAt: firstIndex + 4)) +! ! + +!SACK methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +blocks + ^ (1 to: self numberOfBlocks) collect: [ :each | self blockAt: each] +! ! + +!SACK methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfBlocks + ^ self size - 2 // 8 +! ! + +!SACK methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: '{SACK'. + self numberOfBlocks > 0 ifFalse: [aStream nextPut: $=]. + self blocks do: [ :each | aStream print: each first; nextPut: $-; print: each last] separatedBy: [aStream nextPut: $,]. + aStream nextPut: $} +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SACK class' category: 'SqueakNOS-Net-Options-TCP'! +SACK class + instanceVariableNames: ''! + +!SACK class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + ^ self shouldNotImplement +! ! + +!SACK class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new: anInteger + | length | + length := anInteger * 4 * 2 + 2. + ^ self bytes: + ((ByteArray new: length) + at: 1 put: self type; + at: 2 put: length; + yourself) +! ! + +!SACK class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ 5 +! ! + + diff --git a/modules/NOS/Network/Options/TCP/TCPOption.Class.st b/modules/NOS/Network/Options/TCP/TCPOption.Class.st new file mode 100644 index 00000000..25337221 --- /dev/null +++ b/modules/NOS/Network/Options/TCP/TCPOption.Class.st @@ -0,0 +1,159 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPOption category: 'SqueakNOS-Net-Options-TCP'! +Object subclass: #TCPOption + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Options-TCP'! +!TCPOption commentStamp: '' prior: 0! + +see class methods +http://www.networkcomputing.com/1003/1003ws1.html + +Options: variable + + Options may occupy space at the end of the TCP header and are a + multiple of 8 bits in length. All options are included in the + checksum. An option may begin on any octet boundary. There are two + cases for the format of an option: + + Case 1: A single octet of option-kind. + + Case 2: An octet of option-kind, an octet of option-length, and + the actual option-data octets. + + The option-length counts the two octets of option-kind and + option-length as well as the option-data octets. + + Note that the list of options may be shorter than the data offset + field might imply. The content of the header beyond the + End-of-Option option must be header padding (i.e., zero). + + A TCP must implement all options. + + + [Page 17] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + Currently defined options include (kind indicated in octal): + + Kind Length Meaning + ---- ------ ------- + 0 - End of option list. + 1 - No-Operation. + 2 4 Maximum Segment Size. + + + Specific Option Definitions + + End of Option List + + +--------+ + |00000000| + +--------+ + Kind=0 + + This option code indicates the end of the option list. This + might not coincide with the end of the TCP header according to + the Data Offset field. This is used at the end of all options, + not the end of each option, and need only be used if the end of + the options would not otherwise coincide with the end of the TCP + header. + + No-Operation + + +--------+ + |00000001| + +--------+ + Kind=1 + + This option code may be used between options, for example, to + align the beginning of a subsequent option on a word boundary. + There is no guarantee that senders will use this option, so + receivers must be prepared to process options even if they do + not begin on a word boundary. + + Maximum Segment Size + + +--------+--------+---------+--------+ + |00000010|00000100| max seg size | + +--------+--------+---------+--------+ + Kind=2 Length=4 + + + + + + +[Page 18] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + Maximum Segment Size Option Data: 16 bits + + If this option is present, then it communicates the maximum + receive segment size at the TCP which sends this segment. + This field must only be sent in the initial connection request + (i.e., in segments with the SYN control bit set). If this + option is not used, any segment size is allowed. + +! + +!TCPOption methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isEOL + ^ self type = 0 +! ! + +!TCPOption methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isNOP + ^ self type = 1 +! ! + +!TCPOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + ^ #(End Noop MSS WSopt sackOK SACK six seven TSopt) at: self type + 1 ifAbsent: [super name] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPOption class' category: 'SqueakNOS-Net-Options-TCP'! +TCPOption class + instanceVariableNames: ''! + +!TCPOption class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray offset: anInteger + | type | + type := aByteArray at: anInteger + 1. + self allSubclassesDo: [ :each | + type = each type ifTrue: [^ each new bytes: aByteArray; offset: anInteger]]. + ^ super bytes: aByteArray offset: anInteger +! ! + +!TCPOption class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + ^ self subclassResponsibility +! ! + +!TCPOption class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^ self bytes: ((ByteArray new: self length) at: 1 put: self type; at: 2 put: self length; yourself) +! ! + +!TCPOption class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ nil +! ! + + diff --git a/modules/NOS/Network/Options/TCP/TCPTimestamp.Class.st b/modules/NOS/Network/Options/TCP/TCPTimestamp.Class.st new file mode 100644 index 00000000..9f6a95d1 --- /dev/null +++ b/modules/NOS/Network/Options/TCP/TCPTimestamp.Class.st @@ -0,0 +1,52 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPTimestamp category: 'SqueakNOS-Net-Options-TCP'! +TCPOption subclass: #TCPTimestamp + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Options-TCP'! +!TCPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +echo + ^ self longAt: 7 +! ! + +!TCPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +echo: anInteger + self longAt: 7 put: anInteger +! ! + +!TCPTimestamp methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: '{TSval='; print: self value. + self echo = 0 ifFalse: [aStream nextPutAll: ',TSecr='; print: self echo]. + aStream nextPut: $} +! ! + +!TCPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +value + ^ self longAt: 3 +! ! + +!TCPTimestamp methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +value: anInteger + self longAt: 3 put: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPTimestamp class' category: 'SqueakNOS-Net-Options-TCP'! +TCPTimestamp class + instanceVariableNames: ''! + +!TCPTimestamp class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + ^ 10 +! ! + +!TCPTimestamp class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ 8 +! ! + + diff --git a/modules/NOS/Network/Options/TCP/WindowScale.Class.st b/modules/NOS/Network/Options/TCP/WindowScale.Class.st new file mode 100644 index 00000000..e3e55b5c --- /dev/null +++ b/modules/NOS/Network/Options/TCP/WindowScale.Class.st @@ -0,0 +1,50 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #WindowScale category: 'SqueakNOS-Net-Options-TCP'! +TCPOption subclass: #WindowScale + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Options-TCP'! +!WindowScale methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +factor + ^ 1 bitShift: self shift +! ! + +!WindowScale methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +factor: anInteger + self shift: anInteger highBit - 1 +! ! + +!WindowScale methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: '{WSopt='; print: self factor; nextPut: $} +! ! + +!WindowScale methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +shift + ^ self at: 3 +! ! + +!WindowScale methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +shift: anInteger + self at: 3 put: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WindowScale class' category: 'SqueakNOS-Net-Options-TCP'! +WindowScale class + instanceVariableNames: ''! + +!WindowScale class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + ^ 3 +! ! + +!WindowScale class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ 3 +! ! + + diff --git a/modules/NOS/Network/Packets/EGPPacket.Class.st b/modules/NOS/Network/Packets/EGPPacket.Class.st new file mode 100644 index 00000000..d675964d --- /dev/null +++ b/modules/NOS/Network/Packets/EGPPacket.Class.st @@ -0,0 +1,55 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #EGPPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #EGPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!EGPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum + ^ self shortAt: 5 +! ! + +!EGPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +code + ^ self at: 3 +! ! + +!EGPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence + ^ self shortAt: 9 +! ! + +!EGPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +status + ^ self at: 4 +! ! + +!EGPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +system + ^ self shortAt: 7 +! ! + +!EGPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ self at: 2 +! ! + +!EGPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +version + ^ self at: 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'EGPPacket class' category: 'SqueakNOS-Net-Packets'! +EGPPacket class + instanceVariableNames: ''! + +!EGPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ 8 +! ! + + diff --git a/modules/NOS/Network/Packets/ICMPPacket.Class.st b/modules/NOS/Network/Packets/ICMPPacket.Class.st new file mode 100644 index 00000000..8b057531 --- /dev/null +++ b/modules/NOS/Network/Packets/ICMPPacket.Class.st @@ -0,0 +1,241 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ICMPPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #ICMPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum + ^ self shortAt: 3 +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum: anInteger + self shortAt: 3 put: anInteger +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +code + ^ self at: 2 +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +code: anInteger + self at: 2 put: anInteger +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +codeName + ^ self codeNames at: self code + 1 ifAbsent: [#UnknownCode] +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +codeName: aSymbol + self code: (self codeNames indexOf: aSymbol) - 1 +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +codeNames + self type = 3 "Destination Unreachable" + ifTrue: [^ #(NetUnreachable HostUnreachable ProtocolUnreachable PortUnreachable FragmentationNeeded SourceRouteFailed NetUnknown HostUnknown HostIsolated NetAnomaly HostAnomaly NetUnrTos HostUnrTos PacketFiltered PrecedenceViolation PrecedenceCutOff)]. + self type = 5 "Redirect (change route)" + ifTrue: [^ #(RedirectNet RedirectHost RedirectNetForTOS RedirectHostForTOS)]. + self type = 11 "Time Exceeded" + ifTrue: [^ #(TTLCountExceeded FragmentationReassemblyTimeExceeded)]. + ^ #() +! ! + +!ICMPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +computeChecksum + ^ self checksumFrom: 1 to: self size +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +gateway + ^ InternetAddress bytes: (self copyFrom: 5 to: 8) +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +gateway: anInternetAddress + self replaceFrom: 5 to: 8 with: anInternetAddress asByteArray +! ! + +!ICMPPacket methodsFor: 'accessing-echo' stamp: 'KenD 28/Jun/2026 13:32:25'! +id + ^ self shortAt: 5 +! ! + +!ICMPPacket methodsFor: 'accessing-echo' stamp: 'KenD 28/Jun/2026 13:32:25'! +id: anInteger + self shortAt: 5 put: anInteger +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isDestinationUnreachable + ^ self type = 3 +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isEchoReply + ^ self type = 0 +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isEchoRequest + ^ self type = 8 +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isError + ^ self isQuery not +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isHostUnreachable + ^ self type = 3 and: [self code = 1] +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isNetUnreachable + ^ self type = 3 and: [self code = 0] +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isPortUnreachable + ^ self type = 3 and: [self code = 3] +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isProtocolUnreachable + ^ self type = 3 and: [self code = 2] +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isQuery + ^ #(0 8 9 10 13 14 15 16 17 18) includes: self type +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isRedirect + ^ self type = 5 +! ! + +!ICMPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isTimestampRequest + ^ self type = 13 +! ! + +!ICMPPacket methodsFor: 'accessing-fragmented' stamp: 'KenD 28/Jun/2026 13:32:25'! +mtu + ^ self shortAt: 7 +! ! + +!ICMPPacket methodsFor: 'accessing-fragmented' stamp: 'KenD 28/Jun/2026 13:32:25'! +mtu: anInteger + self shortAt: 7 put: anInteger +! ! + +!ICMPPacket methodsFor: 'accessing-timestamp' stamp: 'KenD 28/Jun/2026 13:32:25'! +originateTimestamp + ^ self longAt: 9 +! ! + +!ICMPPacket methodsFor: 'accessing-timestamp' stamp: 'KenD 28/Jun/2026 13:32:25'! +originateTimestamp: anInteger + self longAt: 9 put: anInteger +! ! + +!ICMPPacket methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: 'ICMP ', self typeName, ' ', self codeName +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +quote + ^ IPPacket on: self +! ! + +!ICMPPacket methodsFor: 'accessing-timestamp' stamp: 'KenD 28/Jun/2026 13:32:25'! +receiveTimestamp + ^ self longAt: 13 +! ! + +!ICMPPacket methodsFor: 'accessing-timestamp' stamp: 'KenD 28/Jun/2026 13:32:25'! +receiveTimestamp: anInteger + self longAt: 13 put: anInteger +! ! + +!ICMPPacket methodsFor: 'accessing-echo' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence + ^ self shortAt: 7 +! ! + +!ICMPPacket methodsFor: 'accessing-echo' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence: anInteger + self shortAt: 7 put: anInteger +! ! + +!ICMPPacket methodsFor: 'accessing-timestamp' stamp: 'KenD 28/Jun/2026 13:32:25'! +transmitTimestamp + ^ self longAt: 17 +! ! + +!ICMPPacket methodsFor: 'accessing-timestamp' stamp: 'KenD 28/Jun/2026 13:32:25'! +transmitTimestamp: anInteger + self longAt: 17 put: anInteger +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ self at: 1 +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type: anInteger + ^ self at: 1 put: anInteger +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +typeName + ^ self typeNames at: self type + 1 +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +typeName: aSymbol + ^ self type: (self typeNames indexOf: aSymbol) - 1 +! ! + +!ICMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +typeNames + ^ #(EchoReply nil nil DestinationUnreachable SourceQuench Redirect nil nil EchoRequest RouterAdvertisement RouterSolicitation TimeExceeded ParameterProblem TimestampRequest TimestampReply InfoRequest InfoReply AddressMaskRequest AddressMaskReply) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ICMPPacket class' category: 'SqueakNOS-Net-Packets'! +ICMPPacket class + instanceVariableNames: ''! + +!ICMPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fieldsNames + ^ #( type typeName code codeName checksum) +! ! + +!ICMPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ 8 +! ! + +!ICMPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ 1 +! ! + +!ICMPPacket class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +quote: anIPPacket + ^ self with: (anIPPacket copyFrom: 1 to: anIPPacket headerSize + 8) +! ! + + diff --git a/modules/NOS/Network/Packets/IGMPPacket.Class.st b/modules/NOS/Network/Packets/IGMPPacket.Class.st new file mode 100644 index 00000000..9b733d39 --- /dev/null +++ b/modules/NOS/Network/Packets/IGMPPacket.Class.st @@ -0,0 +1,70 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IGMPPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #IGMPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!IGMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum + ^ self shortAt: 3 +! ! + +!IGMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum: anInteger + self shortAt: 3 put: anInteger +! ! + +!IGMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +code + ^ self at: 2 +! ! + +!IGMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +code: anInteger + self at: 2 put: anInteger +! ! + +!IGMPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +computeChecksum + ^ 0 +! ! + +!IGMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +group + ^ self longAt: 5 +! ! + +!IGMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +group: anInteger + self longAt: 5 put: anInteger +! ! + +!IGMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ self at: 1 +! ! + +!IGMPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type: anInteger + self at: 1 put: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IGMPPacket class' category: 'SqueakNOS-Net-Packets'! +IGMPPacket class + instanceVariableNames: ''! + +!IGMPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ 8 +! ! + +!IGMPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ 2 +! ! + + diff --git a/modules/NOS/Network/Packets/IGRPPacket.Class.st b/modules/NOS/Network/Packets/IGRPPacket.Class.st new file mode 100644 index 00000000..78a4a20f --- /dev/null +++ b/modules/NOS/Network/Packets/IGRPPacket.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IGRPPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #IGRPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IGRPPacket class' category: 'SqueakNOS-Net-Packets'! +IGRPPacket class + instanceVariableNames: ''! + +!IGRPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ 9 +! ! + + diff --git a/modules/NOS/Network/Packets/IPPacket.Class.st b/modules/NOS/Network/Packets/IPPacket.Class.st new file mode 100644 index 00000000..968befe0 --- /dev/null +++ b/modules/NOS/Network/Packets/IPPacket.Class.st @@ -0,0 +1,2448 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #IPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!IPPacket commentStamp: '' prior: 0! + +Internet RFC/STD/FYI/BCP Archives + + + + RFC791 + + [ Index | Search | What's New | Comments | Help ] + + + +RFC: 791 + + INTERNET PROTOCOL + + DARPA INTERNET PROGRAM + + PROTOCOL SPECIFICATION + + September 1981 + + prepared for + + Defense Advanced Research Projects Agency + Information Processing Techniques Office + 1400 Wilson Boulevard + Arlington, Virginia 22209 + + by + + Information Sciences Institute + University of Southern California + 4676 Admiralty Way + Marina del Rey, California 90291 + +September 1981 + Internet Protocol + + TABLE OF CONTENTS + + PREFACE ........................................................ iii + +1. INTRODUCTION ..................................................... 1 + + 1.1 Motivation .................................................... 1 + 1.2 Scope ......................................................... 1 + 1.3 Interfaces .................................................... 1 + 1.4 Operation ..................................................... 2 + +2. OVERVIEW ......................................................... 5 + + 2.1 Relation to Other Protocols ................................... 9 + 2.2 Model of Operation ............................................ 5 + 2.3 Function Description .......................................... 7 + 2.4 Gateways ...................................................... 9 + +3. SPECIFICATION ................................................... 11 + + 3.1 Internet Header Format ....................................... 11 + 3.2 Discussion ................................................... 23 + 3.3 Interfaces ................................................... 31 + +APPENDIX A: Examples & Scenarios ................................... 34 +APPENDIX B: Data Transmission Order ................................ 39 + +GLOSSARY ............................................................ 41 + +REFERENCES .......................................................... 45 + + [Page i] + + September 1981 +Internet Protocol + +[Page ii] + +September 1981 + Internet Protocol + + PREFACE + +This document specifies the DoD Standard Internet Protocol. This +document is based on six earlier editions of the ARPA Internet Protocol +Specification, and the present text draws heavily from them. There have +been many contributors to this work both in terms of concepts and in +terms of text. This edition revises aspects of addressing, error +handling, option codes, and the security, precedence, compartments, and +handling restriction features of the internet protocol. + + Jon Postel + + Editor + + September 1981 + +RFC: 791 +Replaces: RFC 760 +IENs 128, 123, 111, +80, 54, 44, 41, 28, 26 + + INTERNET PROTOCOL + + DARPA INTERNET PROGRAM + PROTOCOL SPECIFICATION + + 1. INTRODUCTION + +1.1. Motivation + + The Internet Protocol is designed for use in interconnected systems of + packet-switched computer communication networks. Such a system has + been called a "catenet" [1]. The internet protocol provides for + transmitting blocks of data called datagrams from sources to + destinations, where sources and destinations are hosts identified by + fixed length addresses. The internet protocol also provides for + fragmentation and reassembly of long datagrams, if necessary, for + transmission through "small packet" networks. + +1.2. Scope + + The internet protocol is specifically limited in scope to provide the + functions necessary to deliver a package of bits (an internet + datagram) from a source to a destination over an interconnected system + of networks. There are no mechanisms to augment end-to-end data + reliability, flow control, sequencing, or other services commonly + found in host-to-host protocols. The internet protocol can capitalize + on the services of its supporting networks to provide various types + and qualities of service. + +1.3. Interfaces + + This protocol is called on by host-to-host protocols in an internet + environment. This protocol calls on local network protocols to carry + the internet datagram to the next gateway or destination host. + + For example, a TCP module would call on the internet module to take a + TCP segment (including the TCP header and user data) as the data + portion of an internet datagram. The TCP module would provide the + addresses and other parameters in the internet header to the internet + module as arguments of the call. The internet module would then + create an internet datagram and call on the local network interface to + transmit the internet datagram. + + In the ARPANET case, for example, the internet module would call on a + + [Page 1] + + September 1981 +Internet Protocol +Introduction + + local net module which would add the 1822 leader [2] to the internet + datagram creating an ARPANET message to transmit to the IMP. The + ARPANET address would be derived from the internet address by the + local network interface and would be the address of some host in the + ARPANET, that host might be a gateway to other networks. + +1.4. Operation + + The internet protocol implements two basic functions: addressing and + fragmentation. + + The internet modules use the addresses carried in the internet header + to transmit internet datagrams toward their destinations. The + selection of a path for transmission is called routing. + + The internet modules use fields in the internet header to fragment and + reassemble internet datagrams when necessary for transmission through + "small packet" networks. + + The model of operation is that an internet module resides in each host + engaged in internet communication and in each gateway that + interconnects networks. These modules share common rules for + interpreting address fields and for fragmenting and assembling + internet datagrams. In addition, these modules (especially in + gateways) have procedures for making routing decisions and other + functions. + + The internet protocol treats each internet datagram as an independent + entity unrelated to any other internet datagram. There are no + connections or logical circuits (virtual or otherwise). + + The internet protocol uses four key mechanisms in providing its + service: Type of Service, Time to Live, Options, and Header Checksum. + + The Type of Service is used to indicate the quality of the service + desired. The type of service is an abstract or generalized set of + parameters which characterize the service choices provided in the + networks that make up the internet. This type of service indication + is to be used by gateways to select the actual transmission parameters + for a particular network, the network to be used for the next hop, or + the next gateway when routing an internet datagram. + + The Time to Live is an indication of an upper bound on the lifetime of + an internet datagram. It is set by the sender of the datagram and + reduced at the points along the route where it is processed. If the + time to live reaches zero before the internet datagram reaches its + destination, the internet datagram is destroyed. The time to live can + be thought of as a self destruct time limit. + +[Page 2] + +September 1981 + Internet Protocol + Introduction + + The Options provide for control functions needed or useful in some + situations but unnecessary for the most common communications. The + options include provisions for timestamps, security, and special + routing. + + The Header Checksum provides a verification that the information used + in processing internet datagram has been transmitted correctly. The + data may contain errors. If the header checksum fails, the internet + datagram is discarded at once by the entity which detects the error. + + The internet protocol does not provide a reliable communication + facility. There are no acknowledgments either end-to-end or + hop-by-hop. There is no error control for data, only a header + checksum. There are no retransmissions. There is no flow control. + + Errors detected may be reported via the Internet Control Message + Protocol (ICMP) [3] which is implemented in the internet protocol + module. + + [Page 3] + + September 1981 +Internet Protocol + +[Page 4] + +September 1981 + Internet Protocol + + 2. OVERVIEW + +2.1. Relation to Other Protocols + + The following diagram illustrates the place of the internet protocol + in the protocol hierarchy: + + +------+ +-----+ +-----+ +-----+ + |Telnet| | FTP | | TFTP| ... | ... | + +------+ +-----+ +-----+ +-----+ + | | | | + +-----+ +-----+ +-----+ + | TCP | | UDP | ... | ... | + +-----+ +-----+ +-----+ + | | | + +--------------------------+----+ + | Internet Protocol & ICMP | + +--------------------------+----+ + | + +---------------------------+ + | Local Network Protocol | + +---------------------------+ + + Protocol Relationships + + Figure 1. + + Internet protocol interfaces on one side to the higher level + host-to-host protocols and on the other side to the local network + protocol. In this context a "local network" may be a small network in + a building or a large network such as the ARPANET. + +2.2. Model of Operation + + The model of operation for transmitting a datagram from one + application program to another is illustrated by the following + scenario: + + We suppose that this transmission will involve one intermediate + gateway. + + The sending application program prepares its data and calls on its + local internet module to send that data as a datagram and passes the + destination address and other parameters as arguments of the call. + + The internet module prepares a datagram header and attaches the data + to it. The internet module determines a local network address for + this internet address, in this case it is the address of a gateway. + + [Page 5] + + September 1981 +Internet Protocol +Overview + + It sends this datagram and the local network address to the local + network interface. + + The local network interface creates a local network header, and + attaches the datagram to it, then sends the result via the local + network. + + The datagram arrives at a gateway host wrapped in the local network + header, the local network interface strips off this header, and + turns the datagram over to the internet module. The internet module + determines from the internet address that the datagram is to be + forwarded to another host in a second network. The internet module + determines a local net address for the destination host. It calls + on the local network interface for that network to send the + datagram. + + This local network interface creates a local network header and + attaches the datagram sending the result to the destination host. + + At this destination host the datagram is stripped of the local net + header by the local network interface and handed to the internet + module. + + The internet module determines that the datagram is for an + application program in this host. It passes the data to the + application program in response to a system call, passing the source + address and other parameters as results of the call. + + Application Application + Program Program + \ / + Internet Module Internet Module Internet Module + \ / \ / + LNI-1 LNI-1 LNI-2 LNI-2 + \ / \ / + Local Network 1 Local Network 2 + + Transmission Path + + Figure 2 + +[Page 6] + +September 1981 + Internet Protocol + Overview + +2.3. Function Description + + The function or purpose of Internet Protocol is to move datagrams + through an interconnected set of networks. This is done by passing + the datagrams from one internet module to another until the + destination is reached. The internet modules reside in hosts and + gateways in the internet system. The datagrams are routed from one + internet module to another through individual networks based on the + interpretation of an internet address. Thus, one important mechanism + of the internet protocol is the internet address. + + In the routing of messages from one internet module to another, + datagrams may need to traverse a network whose maximum packet size is + smaller than the size of the datagram. To overcome this difficulty, a + fragmentation mechanism is provided in the internet protocol. + + Addressing + + A distinction is made between names, addresses, and routes [4]. A + name indicates what we seek. An address indicates where it is. A + route indicates how to get there. The internet protocol deals + primarily with addresses. It is the task of higher level (i.e., + host-to-host or application) protocols to make the mapping from + names to addresses. The internet module maps internet addresses to + local net addresses. It is the task of lower level (i.e., local net + or gateways) procedures to make the mapping from local net addresses + to routes. + + Addresses are fixed length of four octets (32 bits). An address + begins with a network number, followed by local address (called the + "rest" field). There are three formats or classes of internet + addresses: in class a, the high order bit is zero, the next 7 bits + are the network, and the last 24 bits are the local address; in + class b, the high order two bits are one-zero, the next 14 bits are + the network and the last 16 bits are the local address; in class c, + the high order three bits are one-one-zero, the next 21 bits are the + network and the last 8 bits are the local address. + + Care must be taken in mapping internet addresses to local net + addresses; a single physical host must be able to act as if it were + several distinct hosts to the extent of using several distinct + internet addresses. Some hosts will also have several physical + interfaces (multi-homing). + + That is, provision must be made for a host to have several physical + interfaces to the network with each having several logical internet + addresses. + + [Page 7] + + September 1981 +Internet Protocol +Overview + + Examples of address mappings may be found in "Address Mappings" [5]. + + Fragmentation + + Fragmentation of an internet datagram is necessary when it + originates in a local net that allows a large packet size and must + traverse a local net that limits packets to a smaller size to reach + its destination. + + An internet datagram can be marked "don't fragment." Any internet + datagram so marked is not to be internet fragmented under any + circumstances. If internet datagram marked don't fragment cannot be + delivered to its destination without fragmenting it, it is to be + discarded instead. + + Fragmentation, transmission and reassembly across a local network + which is invisible to the internet protocol module is called + intranet fragmentation and may be used [6]. + + The internet fragmentation and reassembly procedure needs to be able + to break a datagram into an almost arbitrary number of pieces that + can be later reassembled. The receiver of the fragments uses the + identification field to ensure that fragments of different datagrams + are not mixed. The fragment offset field tells the receiver the + position of a fragment in the original datagram. The fragment + offset and length determine the portion of the original datagram + covered by this fragment. The more-fragments flag indicates (by + being reset) the last fragment. These fields provide sufficient + information to reassemble datagrams. + + The identification field is used to distinguish the fragments of one + datagram from those of another. The originating protocol module of + an internet datagram sets the identification field to a value that + must be unique for that source-destination pair and protocol for the + time the datagram will be active in the internet system. The + originating protocol module of a complete datagram sets the + more-fragments flag to zero and the fragment offset to zero. + + To fragment a long internet datagram, an internet protocol module + (for example, in a gateway), creates two new internet datagrams and + copies the contents of the internet header fields from the long + datagram into both new internet headers. The data of the long + datagram is divided into two portions on a 8 octet (64 bit) boundary + (the second portion might not be an integral multiple of 8 octets, + but the first must be). Call the number of 8 octet blocks in the + first portion NFB (for Number of Fragment Blocks). The first + portion of the data is placed in the first new internet datagram, + and the total length field is set to the length of the first + +[Page 8] + +September 1981 + Internet Protocol + Overview + + datagram. The more-fragments flag is set to one. The second + portion of the data is placed in the second new internet datagram, + and the total length field is set to the length of the second + datagram. The more-fragments flag carries the same value as the + long datagram. The fragment offset field of the second new internet + datagram is set to the value of that field in the long datagram plus + NFB. + + This procedure can be generalized for an n-way split, rather than + the two-way split described. + + To assemble the fragments of an internet datagram, an internet + protocol module (for example at a destination host) combines + internet datagrams that all have the same value for the four fields: + identification, source, destination, and protocol. The combination + is done by placing the data portion of each fragment in the relative + position indicated by the fragment offset in that fragment's + internet header. The first fragment will have the fragment offset + zero, and the last fragment will have the more-fragments flag reset + to zero. + +2.4. Gateways + + Gateways implement internet protocol to forward datagrams between + networks. Gateways also implement the Gateway to Gateway Protocol + (GGP) [7] to coordinate routing and other internet control + information. + + In a gateway the higher level protocols need not be implemented and + the GGP functions are added to the IP module. + + +-------------------------------+ + | Internet Protocol & ICMP & GGP| + +-------------------------------+ + | | + +---------------+ +---------------+ + | Local Net | | Local Net | + +---------------+ +---------------+ + + Gateway Protocols + + Figure 3. + + [Page 9] + + September 1981 +Internet Protocol + +[Page 10] + +September 1981 + Internet Protocol + + 3. SPECIFICATION + +3.1. Internet Header Format + + A summary of the contents of the internet header follows: + + 0 1 2 3 + 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + |Version| IHL |Type of Service| Total Length | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Identification |Flags| Fragment Offset | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Time to Live | Protocol | Header Checksum | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Source Address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Destination Address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Options | Padding | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + + Example Internet Datagram Header + + Figure 4. + + Note that each tick mark represents one bit position. + + Version: 4 bits + + The Version field indicates the format of the internet header. This + document describes version 4. + + IHL: 4 bits + + Internet Header Length is the length of the internet header in 32 + bit words, and thus points to the beginning of the data. Note that + the minimum value for a correct header is 5. + + [Page 11] + + September 1981 +Internet Protocol +Specification + + Type of Service: 8 bits + + The Type of Service provides an indication of the abstract + parameters of the quality of service desired. These parameters are + to be used to guide the selection of the actual service parameters + when transmitting a datagram through a particular network. Several + networks offer service precedence, which somehow treats high + precedence traffic as more important than other traffic (generally + by accepting only traffic above a certain precedence at time of high + load). The major choice is a three way tradeoff between low-delay, + high-reliability, and high-throughput. + + Bits 0-2: Precedence. + Bit 3: 0 = Normal Delay, 1 = Low Delay. + Bits 4: 0 = Normal Throughput, 1 = High Throughput. + Bits 5: 0 = Normal Relibility, 1 = High Relibility. + Bit 6-7: Reserved for Future Use. + + 0 1 2 3 4 5 6 7 + +-----+-----+-----+-----+-----+-----+-----+-----+ + | | | | | | | + | PRECEDENCE | D | T | R | 0 | 0 | + | | | | | | | + +-----+-----+-----+-----+-----+-----+-----+-----+ + + Precedence + + 111 - Network Control + 110 - Internetwork Control + 101 - CRITIC/ECP + 100 - Flash Override + 011 - Flash + 010 - Immediate + 001 - Priority + 000 - Routine + + The use of the Delay, Throughput, and Reliability indications may + increase the cost (in some sense) of the service. In many networks + better performance for one of these parameters is coupled with worse + performance on another. Except for very unusual cases at most two + of these three indications should be set. + + The type of service is used to specify the treatment of the datagram + during its transmission through the internet system. Example + mappings of the internet type of service to the actual service + provided on networks such as AUTODIN II, ARPANET, SATNET, and PRNET + is given in "Service Mappings" [8]. + +[Page 12] + +September 1981 + Internet Protocol + Specification + + The Network Control precedence designation is intended to be used + within a network only. The actual use and control of that + designation is up to each network. The Internetwork Control + designation is intended for use by gateway control originators only. + If the actual use of these precedence designations is of concern to + a particular network, it is the responsibility of that network to + control the access to, and use of, those precedence designations. + + Total Length: 16 bits + + Total Length is the length of the datagram, measured in octets, + including internet header and data. This field allows the length of + a datagram to be up to 65,535 octets. Such long datagrams are + impractical for most hosts and networks. All hosts must be prepared + to accept datagrams of up to 576 octets (whether they arrive whole + or in fragments). It is recommended that hosts only send datagrams + larger than 576 octets if they have assurance that the destination + is prepared to accept the larger datagrams. + + The number 576 is selected to allow a reasonable sized data block to + be transmitted in addition to the required header information. For + example, this size allows a data block of 512 octets plus 64 header + octets to fit in a datagram. The maximal internet header is 60 + octets, and a typical internet header is 20 octets, allowing a + margin for headers of higher level protocols. + + Identification: 16 bits + + An identifying value assigned by the sender to aid in assembling the + fragments of a datagram. + + Flags: 3 bits + + Various Control Flags. + + Bit 0: reserved, must be zero + Bit 1: (DF) 0 = May Fragment, 1 = Don't Fragment. + Bit 2: (MF) 0 = Last Fragment, 1 = More Fragments. + + 0 1 2 + +---+---+---+ + | | D | M | + | 0 | F | F | + +---+---+---+ + + Fragment Offset: 13 bits + + This field indicates where in the datagram this fragment belongs. + + [Page 13] + + September 1981 +Internet Protocol +Specification + + The fragment offset is measured in units of 8 octets (64 bits). The + first fragment has offset zero. + + Time to Live: 8 bits + + This field indicates the maximum time the datagram is allowed to + remain in the internet system. If this field contains the value + zero, then the datagram must be destroyed. This field is modified + in internet header processing. The time is measured in units of + seconds, but since every module that processes a datagram must + decrease the TTL by at least one even if it process the datagram in + less than a second, the TTL must be thought of only as an upper + bound on the time a datagram may exist. The intention is to cause + undeliverable datagrams to be discarded, and to bound the maximum + datagram lifetime. + + Protocol: 8 bits + + This field indicates the next level protocol used in the data + portion of the internet datagram. The values for various protocols + are specified in "Assigned Numbers" [9]. + + Header Checksum: 16 bits + + A checksum on the header only. Since some header fields change + (e.g., time to live), this is recomputed and verified at each point + that the internet header is processed. + + The checksum algorithm is: + + The checksum field is the 16 bit one's complement of the one's + complement sum of all 16 bit words in the header. For purposes of + computing the checksum, the value of the checksum field is zero. + + This is a simple to compute checksum and experimental evidence + indicates it is adequate, but it is provisional and may be replaced + by a CRC procedure, depending on further experience. + + Source Address: 32 bits + + The source address. See section 3.2. + + Destination Address: 32 bits + + The destination address. See section 3.2. + +[Page 14] + +September 1981 + Internet Protocol + Specification + + Options: variable + + The options may appear or not in datagrams. They must be + implemented by all IP modules (host and gateways). What is optional + is their transmission in any particular datagram, not their + implementation. + + In some environments the security option may be required in all + datagrams. + + The option field is variable in length. There may be zero or more + options. There are two cases for the format of an option: + + Case 1: A single octet of option-type. + + Case 2: An option-type octet, an option-length octet, and the + actual option-data octets. + + The option-length octet counts the option-type octet and the + option-length octet as well as the option-data octets. + + The option-type octet is viewed as having 3 fields: + + 1 bit copied flag, + 2 bits option class, + 5 bits option number. + + The copied flag indicates that this option is copied into all + fragments on fragmentation. + + 0 = not copied + 1 = copied + + The option classes are: + + 0 = control + 1 = reserved for future use + 2 = debugging and measurement + 3 = reserved for future use + + [Page 15] + + September 1981 +Internet Protocol +Specification + + The following internet options are defined: + + CLASS NUMBER LENGTH DESCRIPTION + ----- ------ ------ ----------- + 0 0 - End of Option list. This option occupies only + 1 octet; it has no length octet. + 0 1 - No Operation. This option occupies only 1 + octet; it has no length octet. + 0 2 11 Security. Used to carry Security, + Compartmentation, User Group (TCC), and + Handling Restriction Codes compatible with DOD + requirements. + 0 3 var. Loose Source Routing. Used to route the + internet datagram based on information + supplied by the source. + 0 9 var. Strict Source Routing. Used to route the + internet datagram based on information + supplied by the source. + 0 7 var. Record Route. Used to trace the route an + internet datagram takes. + 0 8 4 Stream ID. Used to carry the stream + identifier. + 2 4 var. Internet Timestamp. + + Specific Option Definitions + + End of Option List + + +--------+ + |00000000| + +--------+ + Type=0 + + This option indicates the end of the option list. This might + not coincide with the end of the internet header according to + the internet header length. This is used at the end of all + options, not the end of each option, and need only be used if + the end of the options would not otherwise coincide with the end + of the internet header. + + May be copied, introduced, or deleted on fragmentation, or for + any other reason. + +[Page 16] + +September 1981 + Internet Protocol + Specification + + No Operation + + +--------+ + |00000001| + +--------+ + Type=1 + + This option may be used between options, for example, to align + the beginning of a subsequent option on a 32 bit boundary. + + May be copied, introduced, or deleted on fragmentation, or for + any other reason. + + Security + + This option provides a way for hosts to send security, + compartmentation, handling restrictions, and TCC (closed user + group) parameters. The format for this option is as follows: + + +--------+--------+---//---+---//---+---//---+---//---+ + |10000010|00001011|SSS SSS|CCC CCC|HHH HHH| TCC | + +--------+--------+---//---+---//---+---//---+---//---+ + Type=130 Length=11 + + Security (S field): 16 bits + + Specifies one of 16 levels of security (eight of which are + reserved for future use). + + 00000000 00000000 - Unclassified + 11110001 00110101 - Confidential + 01111000 10011010 - EFTO + 10111100 01001101 - MMMM + 01011110 00100110 - PROG + 10101111 00010011 - Restricted + 11010111 10001000 - Secret + 01101011 11000101 - Top Secret + 00110101 11100010 - (Reserved for future use) + 10011010 11110001 - (Reserved for future use) + 01001101 01111000 - (Reserved for future use) + 00100100 10111101 - (Reserved for future use) + 00010011 01011110 - (Reserved for future use) + 10001001 10101111 - (Reserved for future use) + 11000100 11010110 - (Reserved for future use) + 11100010 01101011 - (Reserved for future use) + + [Page 17] + + September 1981 +Internet Protocol +Specification + + Compartments (C field): 16 bits + + An all zero value is used when the information transmitted is + not compartmented. Other values for the compartments field + may be obtained from the Defense Intelligence Agency. + + Handling Restrictions (H field): 16 bits + + The values for the control and release markings are + alphanumeric digraphs and are defined in the Defense + Intelligence Agency Manual DIAM 65-19, "Standard Security + Markings". + + Transmission Control Code (TCC field): 24 bits + + Provides a means to segregate traffic and define controlled + communities of interest among subscribers. The TCC values are + trigraphs, and are available from HQ DCA Code 530. + + Must be copied on fragmentation. This option appears at most + once in a datagram. + + Loose Source and Record Route + + +--------+--------+--------+---------//--------+ + |10000011| length | pointer| route data | + +--------+--------+--------+---------//--------+ + Type=131 + + The loose source and record route (LSRR) option provides a means + for the source of an internet datagram to supply routing + information to be used by the gateways in forwarding the + datagram to the destination, and to record the route + information. + + The option begins with the option type code. The second octet + is the option length which includes the option type code and the + length octet, the pointer octet, and length-3 octets of route + data. The third octet is the pointer into the route data + indicating the octet which begins the next source address to be + processed. The pointer is relative to this option, and the + smallest legal value for the pointer is 4. + + A route data is composed of a series of internet addresses. + Each internet address is 32 bits or 4 octets. If the pointer is + greater than the length, the source route is empty (and the + recorded route full) and the routing is to be based on the + destination address field. + +[Page 18] + +September 1981 + Internet Protocol + Specification + + If the address in destination address field has been reached and + the pointer is not greater than the length, the next address in + the source route replaces the address in the destination address + field, and the recorded route address replaces the source + address just used, and pointer is increased by four. + + The recorded route address is the internet module's own internet + address as known in the environment into which this datagram is + being forwarded. + + This procedure of replacing the source route with the recorded + route (though it is in the reverse of the order it must be in to + be used as a source route) means the option (and the IP header + as a whole) remains a constant length as the datagram progresses + through the internet. + + This option is a loose source route because the gateway or host + IP is allowed to use any route of any number of other + intermediate gateways to reach the next address in the route. + + Must be copied on fragmentation. Appears at most once in a + datagram. + + Strict Source and Record Route + + +--------+--------+--------+---------//--------+ + |10001001| length | pointer| route data | + +--------+--------+--------+---------//--------+ + Type=137 + + The strict source and record route (SSRR) option provides a + means for the source of an internet datagram to supply routing + information to be used by the gateways in forwarding the + datagram to the destination, and to record the route + information. + + The option begins with the option type code. The second octet + is the option length which includes the option type code and the + length octet, the pointer octet, and length-3 octets of route + data. The third octet is the pointer into the route data + indicating the octet which begins the next source address to be + processed. The pointer is relative to this option, and the + smallest legal value for the pointer is 4. + + A route data is composed of a series of internet addresses. + Each internet address is 32 bits or 4 octets. If the pointer is + greater than the length, the source route is empty (and the + + [Page 19] + + September 1981 +Internet Protocol +Specification + + recorded route full) and the routing is to be based on the + destination address field. + + If the address in destination address field has been reached and + the pointer is not greater than the length, the next address in + the source route replaces the address in the destination address + field, and the recorded route address replaces the source + address just used, and pointer is increased by four. + + The recorded route address is the internet module's own internet + address as known in the environment into which this datagram is + being forwarded. + + This procedure of replacing the source route with the recorded + route (though it is in the reverse of the order it must be in to + be used as a source route) means the option (and the IP header + as a whole) remains a constant length as the datagram progresses + through the internet. + + This option is a strict source route because the gateway or host + IP must send the datagram directly to the next address in the + source route through only the directly connected network + indicated in the next address to reach the next gateway or host + specified in the route. + + Must be copied on fragmentation. Appears at most once in a + datagram. + + Record Route + + +--------+--------+--------+---------//--------+ + |00000111| length | pointer| route data | + +--------+--------+--------+---------//--------+ + Type=7 + + The record route option provides a means to record the route of + an internet datagram. + + The option begins with the option type code. The second octet + is the option length which includes the option type code and the + length octet, the pointer octet, and length-3 octets of route + data. The third octet is the pointer into the route data + indicating the octet which begins the next area to store a route + address. The pointer is relative to this option, and the + smallest legal value for the pointer is 4. + + A recorded route is composed of a series of internet addresses. + Each internet address is 32 bits or 4 octets. If the pointer is + +[Page 20] + +September 1981 + Internet Protocol + Specification + + greater than the length, the recorded route data area is full. + The originating host must compose this option with a large + enough route data area to hold all the address expected. The + size of the option does not change due to adding addresses. The + intitial contents of the route data area must be zero. + + When an internet module routes a datagram it checks to see if + the record route option is present. If it is, it inserts its + own internet address as known in the environment into which this + datagram is being forwarded into the recorded route begining at + the octet indicated by the pointer, and increments the pointer + by four. + + If the route data area is already full (the pointer exceeds the + length) the datagram is forwarded without inserting the address + into the recorded route. If there is some room but not enough + room for a full address to be inserted, the original datagram is + considered to be in error and is discarded. In either case an + ICMP parameter problem message may be sent to the source + host [3]. + + Not copied on fragmentation, goes in first fragment only. + Appears at most once in a datagram. + + Stream Identifier + + +--------+--------+--------+--------+ + |10001000|00000010| Stream ID | + +--------+--------+--------+--------+ + Type=136 Length=4 + + This option provides a way for the 16-bit SATNET stream + identifier to be carried through networks that do not support + the stream concept. + + Must be copied on fragmentation. Appears at most once in a + datagram. + + [Page 21] + + September 1981 +Internet Protocol +Specification + + Internet Timestamp + + +--------+--------+--------+--------+ + |01000100| length | pointer|oflw|flg| + +--------+--------+--------+--------+ + | internet address | + +--------+--------+--------+--------+ + | timestamp | + +--------+--------+--------+--------+ + | . | + . + . + Type = 68 + + The Option Length is the number of octets in the option counting + the type, length, pointer, and overflow/flag octets (maximum + length 40). + + The Pointer is the number of octets from the beginning of this + option to the end of timestamps plus one (i.e., it points to the + octet beginning the space for next timestamp). The smallest + legal value is 5. The timestamp area is full when the pointer + is greater than the length. + + The Overflow (oflw) [4 bits] is the number of IP modules that + cannot register timestamps due to lack of space. + + The Flag (flg) [4 bits] values are + + 0 -- time stamps only, stored in consecutive 32-bit words, + + 1 -- each timestamp is preceded with internet address of the + registering entity, + + 3 -- the internet address fields are prespecified. An IP + module only registers its timestamp if it matches its own + address with the next specified internet address. + + The Timestamp is a right-justified, 32-bit timestamp in + milliseconds since midnight UT. If the time is not available in + milliseconds or cannot be provided with respect to midnight UT + then any time may be inserted as a timestamp provided the high + order bit of the timestamp field is set to one to indicate the + use of a non-standard value. + + The originating host must compose this option with a large + enough timestamp data area to hold all the timestamp information + expected. The size of the option does not change due to adding + +[Page 22] + +September 1981 + Internet Protocol + Specification + + timestamps. The intitial contents of the timestamp data area + must be zero or internet address/zero pairs. + + If the timestamp data area is already full (the pointer exceeds + the length) the datagram is forwarded without inserting the + timestamp, but the overflow count is incremented by one. + + If there is some room but not enough room for a full timestamp + to be inserted, or the overflow count itself overflows, the + original datagram is considered to be in error and is discarded. + In either case an ICMP parameter problem message may be sent to + the source host [3]. + + The timestamp option is not copied upon fragmentation. It is + carried in the first fragment. Appears at most once in a + datagram. + + Padding: variable + + The internet header padding is used to ensure that the internet + header ends on a 32 bit boundary. The padding is zero. + +3.2. Discussion + + The implementation of a protocol must be robust. Each implementation + must expect to interoperate with others created by different + individuals. While the goal of this specification is to be explicit + about the protocol there is the possibility of differing + interpretations. In general, an implementation must be conservative + in its sending behavior, and liberal in its receiving behavior. That + is, it must be careful to send well-formed datagrams, but must accept + any datagram that it can interpret (e.g., not object to technical + errors where the meaning is still clear). + + The basic internet service is datagram oriented and provides for the + fragmentation of datagrams at gateways, with reassembly taking place + at the destination internet protocol module in the destination host. + Of course, fragmentation and reassembly of datagrams within a network + or by private agreement between the gateways of a network is also + allowed since this is transparent to the internet protocols and the + higher-level protocols. This transparent type of fragmentation and + reassembly is termed "network-dependent" (or intranet) fragmentation + and is not discussed further here. + + Internet addresses distinguish sources and destinations to the host + level and provide a protocol field as well. It is assumed that each + protocol will provide for whatever multiplexing is necessary within a + host. + + [Page 23] + + September 1981 +Internet Protocol +Specification + + Addressing + + To provide for flexibility in assigning address to networks and + allow for the large number of small to intermediate sized networks + the interpretation of the address field is coded to specify a small + number of networks with a large number of host, a moderate number of + networks with a moderate number of hosts, and a large number of + networks with a small number of hosts. In addition there is an + escape code for extended addressing mode. + + Address Formats: + + High Order Bits Format Class + --------------- ------------------------------- ----- + 0 7 bits of net, 24 bits of host a + 10 14 bits of net, 16 bits of host b + 110 21 bits of net, 8 bits of host c + 111 escape to extended addressing mode + + A value of zero in the network field means this network. This is + only used in certain ICMP messages. The extended addressing mode + is undefined. Both of these features are reserved for future use. + + The actual values assigned for network addresses is given in + "Assigned Numbers" [9]. + + The local address, assigned by the local network, must allow for a + single physical host to act as several distinct internet hosts. + That is, there must be a mapping between internet host addresses and + network/host interfaces that allows several internet addresses to + correspond to one interface. It must also be allowed for a host to + have several physical interfaces and to treat the datagrams from + several of them as if they were all addressed to a single host. + + Address mappings between internet addresses and addresses for + ARPANET, SATNET, PRNET, and other networks are described in "Address + Mappings" [5]. + + Fragmentation and Reassembly. + + The internet identification field (ID) is used together with the + source and destination address, and the protocol fields, to identify + datagram fragments for reassembly. + + The More Fragments flag bit (MF) is set if the datagram is not the + last fragment. The Fragment Offset field identifies the fragment + location, relative to the beginning of the original unfragmented + datagram. Fragments are counted in units of 8 octets. The + +[Page 24] + +September 1981 + Internet Protocol + Specification + + fragmentation strategy is designed so than an unfragmented datagram + has all zero fragmentation information (MF = 0, fragment offset = + 0). If an internet datagram is fragmented, its data portion must be + broken on 8 octet boundaries. + + This format allows 2**13 = 8192 fragments of 8 octets each for a + total of 65,536 octets. Note that this is consistent with the the + datagram total length field (of course, the header is counted in the + total length and not in the fragments). + + When fragmentation occurs, some options are copied, but others + remain with the first fragment only. + + Every internet module must be able to forward a datagram of 68 + octets without further fragmentation. This is because an internet + header may be up to 60 octets, and the minimum fragment is 8 octets. + + Every internet destination must be able to receive a datagram of 576 + octets either in one piece or in fragments to be reassembled. + + The fields which may be affected by fragmentation include: + + (1) options field + (2) more fragments flag + (3) fragment offset + (4) internet header length field + (5) total length field + (6) header checksum + + If the Don't Fragment flag (DF) bit is set, then internet + fragmentation of this datagram is NOT permitted, although it may be + discarded. This can be used to prohibit fragmentation in cases + where the receiving host does not have sufficient resources to + reassemble internet fragments. + + One example of use of the Don't Fragment feature is to down line + load a small host. A small host could have a boot strap program + that accepts a datagram stores it in memory and then executes it. + + The fragmentation and reassembly procedures are most easily + described by examples. The following procedures are example + implementations. + + General notation in the following pseudo programs: "=<" means "less + than or equal", "#" means "not equal", "=" means "equal", "<-" means + "is set to". Also, "x to y" includes x and excludes y; for example, + "4 to 7" would include 4, 5, and 6 (but not 7). + + [Page 25] + + September 1981 +Internet Protocol +Specification + + An Example Fragmentation Procedure + + The maximum sized datagram that can be transmitted through the + next network is called the maximum transmission unit (MTU). + + If the total length is less than or equal the maximum transmission + unit then submit this datagram to the next step in datagram + processing; otherwise cut the datagram into two fragments, the + first fragment being the maximum size, and the second fragment + being the rest of the datagram. The first fragment is submitted + to the next step in datagram processing, while the second fragment + is submitted to this procedure in case it is still too large. + + Notation: + + FO - Fragment Offset + IHL - Internet Header Length + DF - Don't Fragment flag + MF - More Fragments flag + TL - Total Length + OFO - Old Fragment Offset + OIHL - Old Internet Header Length + OMF - Old More Fragments flag + OTL - Old Total Length + NFB - Number of Fragment Blocks + MTU - Maximum Transmission Unit + + Procedure: + + IF TL =< MTU THEN Submit this datagram to the next step + in datagram processing ELSE IF DF = 1 THEN discard the + datagram ELSE + To produce the first fragment: + (1) Copy the original internet header; + (2) OIHL <- IHL; OTL <- TL; OFO <- FO; OMF <- MF; + (3) NFB <- (MTU-IHL*4)/8; + (4) Attach the first NFB*8 data octets; + (5) Correct the header: + MF <- 1; TL <- (IHL*4)+(NFB*8); + Recompute Checksum; + (6) Submit this fragment to the next step in + datagram processing; + To produce the second fragment: + (7) Selectively copy the internet header (some options + are not copied, see option definitions); + (8) Append the remaining data; + (9) Correct the header: + IHL <- (((OIHL*4)-(length of options not copied))+3)/4; + +[Page 26] + +September 1981 + Internet Protocol + Specification + + TL <- OTL - NFB*8 - (OIHL-IHL)*4); + FO <- OFO + NFB; MF <- OMF; Recompute Checksum; + (10) Submit this fragment to the fragmentation test; DONE. + + In the above procedure each fragment (except the last) was made + the maximum allowable size. An alternative might produce less + than the maximum size datagrams. For example, one could implement + a fragmentation procedure that repeatly divided large datagrams in + half until the resulting fragments were less than the maximum + transmission unit size. + + An Example Reassembly Procedure + + For each datagram the buffer identifier is computed as the + concatenation of the source, destination, protocol, and + identification fields. If this is a whole datagram (that is both + the fragment offset and the more fragments fields are zero), then + any reassembly resources associated with this buffer identifier + are released and the datagram is forwarded to the next step in + datagram processing. + + If no other fragment with this buffer identifier is on hand then + reassembly resources are allocated. The reassembly resources + consist of a data buffer, a header buffer, a fragment block bit + table, a total data length field, and a timer. The data from the + fragment is placed in the data buffer according to its fragment + offset and length, and bits are set in the fragment block bit + table corresponding to the fragment blocks received. + + If this is the first fragment (that is the fragment offset is + zero) this header is placed in the header buffer. If this is the + last fragment ( that is the more fragments field is zero) the + total data length is computed. If this fragment completes the + datagram (tested by checking the bits set in the fragment block + table), then the datagram is sent to the next step in datagram + processing; otherwise the timer is set to the maximum of the + current timer value and the value of the time to live field from + this fragment; and the reassembly routine gives up control. + + If the timer runs out, the all reassembly resources for this + buffer identifier are released. The initial setting of the timer + is a lower bound on the reassembly waiting time. This is because + the waiting time will be increased if the Time to Live in the + arriving fragment is greater than the current timer value but will + not be decreased if it is less. The maximum this timer value + could reach is the maximum time to live (approximately 4.25 + minutes). The current recommendation for the initial timer + setting is 15 seconds. This may be changed as experience with + + [Page 27] + + September 1981 +Internet Protocol +Specification + + this protocol accumulates. Note that the choice of this parameter + value is related to the buffer capacity available and the data + rate of the transmission medium; that is, data rate times timer + value equals buffer size (e.g., 10Kb/s X 15s = 150Kb). + + Notation: + + FO - Fragment Offset + IHL - Internet Header Length + MF - More Fragments flag + TTL - Time To Live + NFB - Number of Fragment Blocks + TL - Total Length + TDL - Total Data Length + BUFID - Buffer Identifier + RCVBT - Fragment Received Bit Table + TLB - Timer Lower Bound + + Procedure: + + (1) BUFID <- source|destination|protocol|identification; + (2) IF FO = 0 AND MF = 0 + (3) THEN IF buffer with BUFID is allocated + (4) THEN flush all reassembly for this BUFID; + (5) Submit datagram to next step; DONE. + (6) ELSE IF no buffer with BUFID is allocated + (7) THEN allocate reassembly resources + with BUFID; + TIMER <- TLB; TDL <- 0; + (8) put data from fragment into data buffer with + BUFID from octet FO*8 to + octet (TL-(IHL*4))+FO*8; + (9) set RCVBT bits from FO + to FO+((TL-(IHL*4)+7)/8); + (10) IF MF = 0 THEN TDL <- TL-(IHL*4)+(FO*8) + (11) IF FO = 0 THEN put header in header buffer + (12) IF TDL # 0 + (13) AND all RCVBT bits from 0 + to (TDL+7)/8 are set + (14) THEN TL <- TDL+(IHL*4) + (15) Submit datagram to next step; + (16) free all reassembly resources + for this BUFID; DONE. + (17) TIMER <- MAX(TIMER,TTL); + (18) give up until next fragment or timer expires; + (19) timer expires: flush all reassembly with this BUFID; DONE. + + In the case that two or more fragments contain the same data + +[Page 28] + +September 1981 + Internet Protocol + Specification + + either identically or through a partial overlap, this procedure + will use the more recently arrived copy in the data buffer and + datagram delivered. + + Identification + + The choice of the Identifier for a datagram is based on the need to + provide a way to uniquely identify the fragments of a particular + datagram. The protocol module assembling fragments judges fragments + to belong to the same datagram if they have the same source, + destination, protocol, and Identifier. Thus, the sender must choose + the Identifier to be unique for this source, destination pair and + protocol for the time the datagram (or any fragment of it) could be + alive in the internet. + + It seems then that a sending protocol module needs to keep a table + of Identifiers, one entry for each destination it has communicated + with in the last maximum packet lifetime for the internet. + + However, since the Identifier field allows 65,536 different values, + some host may be able to simply use unique identifiers independent + of destination. + + It is appropriate for some higher level protocols to choose the + identifier. For example, TCP protocol modules may retransmit an + identical TCP segment, and the probability for correct reception + would be enhanced if the retransmission carried the same identifier + as the original transmission since fragments of either datagram + could be used to construct a correct TCP segment. + + Type of Service + + The type of service (TOS) is for internet service quality selection. + The type of service is specified along the abstract parameters + precedence, delay, throughput, and reliability. These abstract + parameters are to be mapped into the actual service parameters of + the particular networks the datagram traverses. + + Precedence. An independent measure of the importance of this + datagram. + + Delay. Prompt delivery is important for datagrams with this + indication. + + Throughput. High data rate is important for datagrams with this + indication. + + [Page 29] + + September 1981 +Internet Protocol +Specification + + Reliability. A higher level of effort to ensure delivery is + important for datagrams with this indication. + + For example, the ARPANET has a priority bit, and a choice between + "standard" messages (type 0) and "uncontrolled" messages (type 3), + (the choice between single packet and multipacket messages can also + be considered a service parameter). The uncontrolled messages tend + to be less reliably delivered and suffer less delay. Suppose an + internet datagram is to be sent through the ARPANET. Let the + internet type of service be given as: + + Precedence: 5 + Delay: 0 + Throughput: 1 + Reliability: 1 + + In this example, the mapping of these parameters to those available + for the ARPANET would be to set the ARPANET priority bit on since + the Internet precedence is in the upper half of its range, to select + standard messages since the throughput and reliability requirements + are indicated and delay is not. More details are given on service + mappings in "Service Mappings" [8]. + + Time to Live + + The time to live is set by the sender to the maximum time the + datagram is allowed to be in the internet system. If the datagram + is in the internet system longer than the time to live, then the + datagram must be destroyed. + + This field must be decreased at each point that the internet header + is processed to reflect the time spent processing the datagram. + Even if no local information is available on the time actually + spent, the field must be decremented by 1. The time is measured in + units of seconds (i.e. the value 1 means one second). Thus, the + maximum time to live is 255 seconds or 4.25 minutes. Since every + module that processes a datagram must decrease the TTL by at least + one even if it process the datagram in less than a second, the TTL + must be thought of only as an upper bound on the time a datagram may + exist. The intention is to cause undeliverable datagrams to be + discarded, and to bound the maximum datagram lifetime. + + Some higher level reliable connection protocols are based on + assumptions that old duplicate datagrams will not arrive after a + certain time elapses. The TTL is a way for such protocols to have + an assurance that their assumption is met. + +[Page 30] + +September 1981 + Internet Protocol + Specification + + Options + + The options are optional in each datagram, but required in + implementations. That is, the presence or absence of an option is + the choice of the sender, but each internet module must be able to + parse every option. There can be several options present in the + option field. + + The options might not end on a 32-bit boundary. The internet header + must be filled out with octets of zeros. The first of these would + be interpreted as the end-of-options option, and the remainder as + internet header padding. + + Every internet module must be able to act on every option. The + Security Option is required if classified, restricted, or + compartmented traffic is to be passed. + + Checksum + + The internet header checksum is recomputed if the internet header is + changed. For example, a reduction of the time to live, additions or + changes to internet options, or due to fragmentation. This checksum + at the internet level is intended to protect the internet header + fields from transmission errors. + + There are some applications where a few data bit errors are + acceptable while retransmission delays are not. If the internet + protocol enforced data correctness such applications could not be + supported. + + Errors + + Internet protocol errors may be reported via the ICMP messages [3]. + +3.3. Interfaces + + The functional description of user interfaces to the IP is, at best, + fictional, since every operating system will have different + facilities. Consequently, we must warn readers that different IP + implementations may have different user interfaces. However, all IPs + must provide a certain minimum set of services to guarantee that all + IP implementations can support the same protocol hierarchy. This + section specifies the functional interfaces required of all IP + implementations. + + Internet protocol interfaces on one side to the local network and on + the other side to either a higher level protocol or an application + program. In the following, the higher level protocol or application + + [Page 31] + + September 1981 +Internet Protocol +Specification + + program (or even a gateway program) will be called the "user" since it + is using the internet module. Since internet protocol is a datagram + protocol, there is minimal memory or state maintained between datagram + transmissions, and each call on the internet protocol module by the + user supplies all information necessary for the IP to perform the + service requested. + + An Example Upper Level Interface + + The following two example calls satisfy the requirements for the user + to internet protocol module communication ("=>" means returns): + + SEND (src, dst, prot, TOS, TTL, BufPTR, len, Id, DF, opt => result) + + where: + + src = source address + dst = destination address + prot = protocol + TOS = type of service + TTL = time to live + BufPTR = buffer pointer + len = length of buffer + Id = Identifier + DF = Don't Fragment + opt = option data + result = response + OK = datagram sent ok + Error = error in arguments or local network error + + Note that the precedence is included in the TOS and the + security/compartment is passed as an option. + + RECV (BufPTR, prot, => result, src, dst, TOS, len, opt) + + where: + + BufPTR = buffer pointer + prot = protocol + result = response + OK = datagram received ok + Error = error in arguments + len = length of buffer + src = source address + dst = destination address + TOS = type of service + opt = option data + +[Page 32] + +September 1981 + Internet Protocol + Specification + + When the user sends a datagram, it executes the SEND call supplying + all the arguments. The internet protocol module, on receiving this + call, checks the arguments and prepares and sends the message. If the + arguments are good and the datagram is accepted by the local network, + the call returns successfully. If either the arguments are bad, or + the datagram is not accepted by the local network, the call returns + unsuccessfully. On unsuccessful returns, a reasonable report must be + made as to the cause of the problem, but the details of such reports + are up to individual implementations. + + When a datagram arrives at the internet protocol module from the local + network, either there is a pending RECV call from the user addressed + or there is not. In the first case, the pending call is satisfied by + passing the information from the datagram to the user. In the second + case, the user addressed is notified of a pending datagram. If the + user addressed does not exist, an ICMP error message is returned to + the sender, and the data is discarded. + + The notification of a user may be via a pseudo interrupt or similar + mechanism, as appropriate in the particular operating system + environment of the implementation. + + A user's RECV call may then either be immediately satisfied by a + pending datagram, or the call may be pending until a datagram arrives. + + The source address is included in the send call in case the sending + host has several addresses (multiple physical connections or logical + addresses). The internet module must check to see that the source + address is one of the legal address for this host. + + An implementation may also allow or require a call to the internet + module to indicate interest in or reserve exclusive use of a class of + datagrams (e.g., all those with a certain value in the protocol + field). + + This section functionally characterizes a USER/IP interface. The + notation used is similar to most procedure of function calls in high + level languages, but this usage is not meant to rule out trap type + service calls (e.g., SVCs, UUOs, EMTs), or any other form of + interprocess communication. + + [Page 33] + + September 1981 +Internet Protocol + +APPENDIX A: Examples & Scenarios + +Example 1: + + This is an example of the minimal data carrying internet datagram: + + 0 1 2 3 + 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + |Ver= 4 |IHL= 5 |Type of Service| Total Length = 21 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Identification = 111 |Flg=0| Fragment Offset = 0 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Time = 123 | Protocol = 1 | header checksum | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | source address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | destination address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + +-+-+-+-+-+-+-+-+ + + Example Internet Datagram + + Figure 5. + + Note that each tick mark represents one bit position. + + This is a internet datagram in version 4 of internet protocol; the + internet header consists of five 32 bit words, and the total length of + the datagram is 21 octets. This datagram is a complete datagram (not + a fragment). + +[Page 34] + +September 1981 + Internet Protocol + +Example 2: + + In this example, we show first a moderate size internet datagram (452 + data octets), then two internet fragments that might result from the + fragmentation of this datagram if the maximum sized transmission + allowed were 280 octets. + + 0 1 2 3 + 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + |Ver= 4 |IHL= 5 |Type of Service| Total Length = 472 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Identification = 111 |Flg=0| Fragment Offset = 0 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Time = 123 | Protocol = 6 | header checksum | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | source address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | destination address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + \ \ + \ \ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + + Example Internet Datagram + + Figure 6. + + [Page 35] + + September 1981 +Internet Protocol + + Now the first fragment that results from splitting the datagram after + 256 data octets. + + 0 1 2 3 + 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + |Ver= 4 |IHL= 5 |Type of Service| Total Length = 276 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Identification = 111 |Flg=1| Fragment Offset = 0 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Time = 119 | Protocol = 6 | Header Checksum | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | source address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | destination address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + \ \ + \ \ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + + Example Internet Fragment + + Figure 7. + +[Page 36] + +September 1981 + Internet Protocol + + And the second fragment. + + 0 1 2 3 + 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + |Ver= 4 |IHL= 5 |Type of Service| Total Length = 216 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Identification = 111 |Flg=0| Fragment Offset = 32 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Time = 119 | Protocol = 6 | Header Checksum | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | source address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | destination address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + \ \ + \ \ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + + Example Internet Fragment + + Figure 8. + + [Page 37] + + September 1981 +Internet Protocol + +Example 3: + + Here, we show an example of a datagram containing options: + + 0 1 2 3 + 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + |Ver= 4 |IHL= 8 |Type of Service| Total Length = 576 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Identification = 111 |Flg=0| Fragment Offset = 0 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Time = 123 | Protocol = 6 | Header Checksum | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | source address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | destination address | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Opt. Code = x | Opt. Len.= 3 | option value | Opt. Code = x | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Opt. Len. = 4 | option value | Opt. Code = 1 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Opt. Code = y | Opt. Len. = 3 | option value | Opt. Code = 0 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + \ \ + \ \ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + + Example Internet Datagram + + Figure 9. + +[Page 38] + +September 1981 + Internet Protocol + +APPENDIX B: Data Transmission Order + +The order of transmission of the header and data described in this +document is resolved to the octet level. Whenever a diagram shows a +group of octets, the order of transmission of those octets is the normal +order in which they are read in English. For example, in the following +diagram the octets are transmitted in the order they are numbered. + + 0 1 2 3 + 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | 1 | 2 | 3 | 4 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | 5 | 6 | 7 | 8 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | 9 | 10 | 11 | 12 | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + + Transmission Order of Bytes + + Figure 10. + +Whenever an octet represents a numeric quantity the left most bit in the +diagram is the high order or most significant bit. That is, the bit +labeled 0 is the most significant bit. For example, the following +diagram represents the value 170 (decimal). + + 0 1 2 3 4 5 6 7 + +-+-+-+-+-+-+-+-+ + |1 0 1 0 1 0 1 0| + +-+-+-+-+-+-+-+-+ + + Significance of Bits + + Figure 11. + +Similarly, whenever a multi-octet field represents a numeric quantity +the left most bit of the whole field is the most significant bit. When +a multi-octet quantity is transmitted the most significant octet is +transmitted first. + + [Page 39] + + September 1981 +Internet Protocol + +[Page 40] + +September 1981 + Internet Protocol + + GLOSSARY + +1822 + BBN Report 1822, "The Specification of the Interconnection of + a Host and an IMP". The specification of interface between a + host and the ARPANET. + +ARPANET leader + The control information on an ARPANET message at the host-IMP + interface. + +ARPANET message + The unit of transmission between a host and an IMP in the + ARPANET. The maximum size is about 1012 octets (8096 bits). + +ARPANET packet + A unit of transmission used internally in the ARPANET between + IMPs. The maximum size is about 126 octets (1008 bits). + +Destination + The destination address, an internet header field. + +DF + The Don't Fragment bit carried in the flags field. + +Flags + An internet header field carrying various control flags. + +Fragment Offset + This internet header field indicates where in the internet + datagram a fragment belongs. + +GGP + Gateway to Gateway Protocol, the protocol used primarily + between gateways to control routing and other gateway + functions. + +header + Control information at the beginning of a message, segment, + datagram, packet or block of data. + +ICMP + Internet Control Message Protocol, implemented in the internet + module, the ICMP is used from gateways to hosts and between + hosts to report errors and make routing suggestions. + + [Page 41] + + September 1981 +Internet Protocol +Glossary + +Identification + An internet header field carrying the identifying value + assigned by the sender to aid in assembling the fragments of a + datagram. + +IHL + The internet header field Internet Header Length is the length + of the internet header measured in 32 bit words. + +IMP + The Interface Message Processor, the packet switch of the + ARPANET. + +Internet Address + A four octet (32 bit) source or destination address consisting + of a Network field and a Local Address field. + +internet datagram + The unit of data exchanged between a pair of internet modules + (includes the internet header). + +internet fragment + A portion of the data of an internet datagram with an internet + header. + +Local Address + The address of a host within a network. The actual mapping of + an internet local address on to the host addresses in a + network is quite general, allowing for many to one mappings. + +MF + The More-Fragments Flag carried in the internet header flags + field. + +module + An implementation, usually in software, of a protocol or other + procedure. + +more-fragments flag + A flag indicating whether or not this internet datagram + contains the end of an internet datagram, carried in the + internet header Flags field. + +NFB + The Number of Fragment Blocks in a the data portion of an + internet fragment. That is, the length of a portion of data + measured in 8 octet units. + +[Page 42] + +September 1981 + Internet Protocol + Glossary + +octet + An eight bit byte. + +Options + The internet header Options field may contain several options, + and each option may be several octets in length. + +Padding + The internet header Padding field is used to ensure that the + data begins on 32 bit word boundary. The padding is zero. + +Protocol + In this document, the next higher level protocol identifier, + an internet header field. + +Rest + The local address portion of an Internet Address. + +Source + The source address, an internet header field. + +TCP + Transmission Control Protocol: A host-to-host protocol for + reliable communication in internet environments. + +TCP Segment + The unit of data exchanged between TCP modules (including the + TCP header). + +TFTP + Trivial File Transfer Protocol: A simple file transfer + protocol built on UDP. + +Time to Live + An internet header field which indicates the upper bound on + how long this internet datagram may exist. + +TOS + Type of Service + +Total Length + The internet header field Total Length is the length of the + datagram in octets including internet header and data. + +TTL + Time to Live + + [Page 43] + + September 1981 +Internet Protocol +Glossary + +Type of Service + An internet header field which indicates the type (or quality) + of service for this internet datagram. + +UDP + User Datagram Protocol: A user level protocol for transaction + oriented applications. + +User + The user of the internet protocol. This may be a higher level + protocol module, an application program, or a gateway program. + +Version + The Version field indicates the format of the internet header. + +[Page 44] + +September 1981 + Internet Protocol + + REFERENCES + +[1] Cerf, V., "The Catenet Model for Internetworking," Information + Processing Techniques Office, Defense Advanced Research Projects + Agency, IEN 48, July 1978. + +[2] Bolt Beranek and Newman, "Specification for the Interconnection of + a Host and an IMP," BBN Technical Report 1822, Revised May 1978. + +[3] Postel, J., "Internet Control Message Protocol - DARPA Internet + Program Protocol Specification," RFC 792, USC/Information Sciences + Institute, September 1981. + +[4] Shoch, J., "Inter-Network Naming, Addressing, and Routing," + COMPCON, IEEE Computer Society, Fall 1978. + +[5] Postel, J., "Address Mappings," RFC 796, USC/Information Sciences + Institute, September 1981. + +[6] Shoch, J., "Packet Fragmentation in Inter-Network Protocols," + Computer Networks, v. 3, n. 1, February 1979. + +[7] Strazisar, V., "How to Build a Gateway", IEN 109, Bolt Beranek and + Newman, August 1979. + +[8] Postel, J., "Service Mappings," RFC 795, USC/Information Sciences + Institute, September 1981. + +[9] Postel, J., "Assigned Numbers," RFC 790, USC/Information Sciences + Institute, September 1981. + + + + [ Index | Search | What's New | Comments | Help ] + + Comments/Questions about this archive ? Send mail to rfc-admin@faqs.org + + +! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum + ^ self shortAt: 11 +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum: anInteger + self shortAt: 11 put: anInteger +! ! + +!IPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +computeChecksum + ^ self checksumFrom: 1 to: self headerSize +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +data + | proto | + proto := self protocol. + Packet allSubclassesDo: [ :each | each protocol = proto ifTrue: [^ each on: self]]. + ^ nil +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination + ^ InternetAddress bytes: (self copyFrom: 17 to: 20) +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination: anInternetAddress + self replaceFrom: 17 to: 20 with: anInternetAddress asByteArray +! ! + +!IPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +df + "Answer true if the 'dont fragment' flag is set." + ^ self flags anyMask: 2 +! ! + +!IPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +df: aBoolean + "Set the 'dont fragment' flag." + self flags: (aBoolean ifTrue: [self flags bitOr: 2] ifFalse: [self flags bitClear: 2]) +! ! + +!IPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +flags + ^ (self at: 7) bitShift: -5 +! ! + +!IPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +flags: anInteger + self + at: 7 + put: (((self at: 7) + bitAnd: 2r00011111) + bitOr: (anInteger bitShift: 5)) + +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fragmentOffset + ^ ((self shortAt: 7) bitAnd: 16r1FFF) * 8 +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fragmentOffset: fragmentOffset + self shortAt: 7 put: (((self shortAt: 7) bitAnd: 16rE000) bitOr: fragmentOffset // 8) +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fragmentsSized: anInteger + | fragmentsSize fragmentOffset prototype fragments | + anInteger >= self size ifTrue: [^ Array with: self]. + fragmentOffset := 0. + fragmentsSize := anInteger - self headerSize truncateTo: 8. + prototype := self class new: anInteger. + prototype replaceFrom: 1 to: self headerSize with: self startingAt: 1. + fragments := (1 to: self length + fragmentsSize - 1 // fragmentsSize) collect: [:index | + fragmentOffset := index - 1 * fragmentsSize + self fragmentOffset. + prototype copy + fragmentOffset: fragmentOffset; + length: fragmentsSize + self headerSize; + mf: true; + replaceFrom: prototype headerSize + 1 to: prototype size with: self bytes startingAt: self offset + self headerSize + 1; + setChecksum]. + fragments last mf: self mf. + self length - self headerSize \\ fragmentsSize = 0 + ifFalse: [fragments last + length: (self length - self headerSize \\ fragmentsSize) + self headerSize]. + fragments last setChecksum. + ^ fragments +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerLength + ^ ((self at: 1) bitAnd: 16rF) * 4 +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerLength: anInteger + self at: 1 put: ((self at: 1) bitOr: anInteger // 4) +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ self headerLength +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +id + ^ self shortAt: 5 +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +id: anInteger + self shortAt: 5 put: anInteger +! ! + +!IPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isFragment + ^ self mf or: [self fragmentOffset > 0] +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + ^ self shortAt: 3 +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length: anInteger + self shortAt: 3 put: anInteger +! ! + +!IPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +mf + "Answer true if the motherfucker flag is set." + ^ self flags anyMask: 1 +! ! + +!IPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +mf: aBoolean + "Set the motherfucker." + self flags: (aBoolean ifTrue: [self flags bitOr: 1] ifFalse: [self flags bitClear: 1]) +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +options + | answer index option | + answer := OrderedCollection new. + index := 20. + [index >= self headerSize] + whileFalse: [option := IPOption bytes: bytes offset: offset + index. + option size = 0 ifTrue: [^ self error: 'Zero size option']. + index := index + option size. + option isEOL ifTrue: [^ answer]. + answer add: option]. + ^ answer +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +options: aCollection + | index | + index := 21. + aCollection do: [ :each | + (index + each size - 1) >= self headerSize ifTrue: [^ self error: 'not enough space for options']. + self replaceFrom: index to: index + each size - 1 with: each. + index := index + each size] +! ! + +!IPPacket methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + self isFragment ifTrue: [aStream nextPutAll: 'IP Fragment '] ifFalse: [aStream nextPutAll: 'IP ']. + aStream print: self source; nextPutAll: ' -> '; print: self destination. + self df ifTrue: [aStream nextPutAll: ' (DF)']. + self options do: [ :each | aStream space; print: each] +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ self at: 10 +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol: anInteger + self at: 10 put: anInteger +! ! + +!IPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +pseudoHeaderChecksum + ^ self normalizeChecksum: (self checksumFrom: 13 to: 20) + self protocol + self length - self headerSize +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +source + ^ InternetAddress bytes: (self copyFrom: 13 to: 16) +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +source: anInternetAddress + self replaceFrom: 13 to: 16 with: anInternetAddress asByteArray +! ! + +!IPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +swapSourceAndDestination + | oldSource | + oldSource := self source. + self source: self destination. + self destination: oldSource +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +tos + ^ self at: 2 +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +tos: anInteger + self at: 2 put: anInteger +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +ttl + ^ self at: 9 +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +ttl: anInteger + self at: 9 put: anInteger +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +version + ^ (self at: 1) bitShift: -4 +! ! + +!IPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +version: anInteger + self at: 1 put: ((anInteger bitShift: 4) bitOr: ((self at: 1) bitAnd: 16r0F)) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPPacket class' category: 'SqueakNOS-Net-Packets'! +IPPacket class + instanceVariableNames: ''! + +!IPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +etherType + ^ 16r800 +! ! + +!IPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fieldsNames + ^ #(version headerLength tos length id fragmentOffset ttl protocol checksum source destination df mf options) +! ! + +!IPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ 20 +! ! + +!IPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ 4 +! ! + +!IPPacket class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +with: aPacket headerSize: anInteger + ^ (super with: aPacket headerSize: anInteger) + headerLength: anInteger; + protocol: aPacket class protocol; + version: 4; + ttl: 255; + length: aPacket size + anInteger +! ! + + diff --git a/modules/NOS/Network/Packets/IPv6Packet.Class.st b/modules/NOS/Network/Packets/IPv6Packet.Class.st new file mode 100644 index 00000000..8ff4b24a --- /dev/null +++ b/modules/NOS/Network/Packets/IPv6Packet.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPv6Packet category: 'SqueakNOS-Net-Packets'! +IPPacket subclass: #IPv6Packet + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPv6Packet class' category: 'SqueakNOS-Net-Packets'! +IPv6Packet class + instanceVariableNames: ''! + +!IPv6Packet class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +etherType + ^ 16r86DD +! ! + + diff --git a/modules/NOS/Network/Packets/IRTPPacket.Class.st b/modules/NOS/Network/Packets/IRTPPacket.Class.st new file mode 100644 index 00000000..c2ff575c --- /dev/null +++ b/modules/NOS/Network/Packets/IRTPPacket.Class.st @@ -0,0 +1,100 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IRTPPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #IRTPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum + ^ self shortAt: 7 +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum: anInteger + ^ self shortAt: 7 put: anInteger +! ! + +!IRTPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +computeChecksum + ^ self checksumFrom: 1 to: self size +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + ^ self shortAt: 5 +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length: anInteger + ^ self shortAt: 5 put: anInteger +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +port + ^ self second +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +port: anInteger + ^ self at: 2 put: anInteger +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence + ^ self shortAt: 3 +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence: anInteger + ^ self shortAt: 3 put: anInteger +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ self first +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type: anInteger + self at: 1 put: anInteger +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +typeName + ^ self typeNames at: self type + 1 +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +typeName: aSymbol + ^ self type: (self typeNames indexOf: aSymbol) - 1 +! ! + +!IRTPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +typeNames + ^ #(Synch SynchAck Data DataAck PortNak) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IRTPPacket class' category: 'SqueakNOS-Net-Packets'! +IRTPPacket class + instanceVariableNames: ''! + +!IRTPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fieldsNames + ^ #(type typeName port sequence length checksum) +! ! + +!IRTPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ 8 +! ! + +!IRTPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ 28 +! ! + + diff --git a/modules/NOS/Network/Packets/Packet.Class.st b/modules/NOS/Network/Packets/Packet.Class.st new file mode 100644 index 00000000..ecb5ca19 --- /dev/null +++ b/modules/NOS/Network/Packets/Packet.Class.st @@ -0,0 +1,322 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #Packet category: 'SqueakNOS-Net-Packets'! +ArrayedCollection subclass: #Packet + instanceVariableNames: 'bytes offset envelope' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!Packet methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +>> aConduit + aConduit input: self +! ! + +!Packet methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +asByteArray + ^ bytes copyFrom: 1 + offset to: bytes size +! ! + +!Packet methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +asString + ^ self asByteArray asString +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger + ^ bytes at: anInteger + offset +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger put: aByte + ^ bytes at: anInteger + offset put: aByte +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes + ^ bytes +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray + bytes := aByteArray asByteArray +! ! + +!Packet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksumFrom: start to: stop + ^ self checksumOf: bytes from: start + offset to: stop + offset +! ! + +!Packet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksumOf: aByteArray from: start to: stop + | nleft sum pos | + nleft := stop - start + 1. + sum := 0. + + pos := start. + [nleft > 1] + whileTrue: [sum := (aByteArray at: pos) * 256 + (aByteArray at: pos+1) + sum. + pos := pos + 2. + nleft := nleft - 2]. + + nleft = 1 ifTrue: [sum := (aByteArray at: pos) * 256 + sum]. + + ^ self normalizeChecksum: sum +! ! + +!Packet methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +computeChecksum + ^ self subclassResponsibility +! ! + +!Packet methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:32:25'! +copy + ^ self class bytes: bytes copy offset: offset +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +data + ^ nil +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +envelope + ^ envelope +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +envelope: aPacket + envelope := aPacket +! ! + +!Packet methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fullPrintOn: aStream + | packet | + packet := self. + [aStream print: packet; space. + (packet := packet data) isNil] whileFalse: [aStream nextPutAll: '| '] +! ! + +!Packet methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fullPrintString + ^ String streamContents: [ :stream | self fullPrintOn: stream] +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ self class headerSize +! ! + +!Packet methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + offset := 0 +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +longAt: anInteger + ^ (self shortAt: anInteger) * 16r10000 + (self shortAt: anInteger + 2) +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +longAt: anInteger put: aLong + self shortAt: anInteger put: aLong // 16r10000. + self shortAt: anInteger+2 put: aLong \\ 16r10000. + ^ aLong +! ! + +!Packet methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +normalizeChecksum: anInteger + | sum | + sum := anInteger. + sum := sum >> 16 + (sum bitAnd: 16rFFFF). "add hi 16 + low 16". + sum := sum >> 16 + sum. "add carry" + ^ sum bitAnd: 16rFFFF "truncate to 16 bits" +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +offset + ^ offset +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +offset: anInteger + offset := anInteger +! ! + +!Packet methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream print: self class; space. + self do: [ :each | + aStream + nextPut: ('0123456789ABCDEF' at: each // 16 + 1); + nextPut: ('0123456789ABCDEF' at: (each \\ 16 + 1))] +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +rawData + ^ self copyFrom: self headerSize + 1 to: self size +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +rawDataStream + ^ bytes readStream position: self headerSize + offset +! ! + +!Packet methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +setChecksum + self checksum: 0. + self checksum: 16rFFFF - self computeChecksum +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +shortAt: anInteger + ^ (self at: anInteger) * 256 + (self at: anInteger+1) +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +shortAt: anInteger put: aShort + self at: anInteger put: aShort // 256. + self at: anInteger+1 put: aShort \\ 256. + ^ aShort +! ! + +!Packet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ bytes size - offset +! ! + +!Packet methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +species + ^ ByteArray +! ! + +!Packet methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +verifiesChecksum + ^ self computeChecksum = 16rFFFF +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Packet class' category: 'SqueakNOS-Net-Packets'! +Packet class + instanceVariableNames: ''! + +!Packet class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +allFieldsNames + ^ self basicFieldsNames, self fieldsNames +! ! + +!Packet class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +basicFieldsNames + ^ #(self bytes offset envelope data rawData) +! ! + +!Packet class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray + ^ self bytes: aByteArray offset: 0 +! ! + +!Packet class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray offset: anInteger + | bytes | + anInteger >= 0 ifTrue: [^ self new bytes: aByteArray; offset: anInteger]. + bytes := ByteArray new: aByteArray size - anInteger. + bytes replaceFrom: anInteger negated + 1 to: bytes size with: aByteArray. + ^ self new bytes: bytes; offset: 0 +! ! + +!Packet class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +create: link identity: identity kind: kind + + ^ super new + link: link + identity: identity + kind: kind + +! ! + +!Packet class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +etherType + ^ nil +! ! + +!Packet class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fieldsNames + ^ #() +! ! + +!Packet class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ self error: 'undefined header size' +! ! + +!Packet class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^ self basicNew initialize +! ! + +!Packet class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new: anInteger + ^ self bytes: (ByteArray new: 1500) offset: 1500 - anInteger - self headerSize +" +Note: the number 1500 is the default buffer size, a number supposedly close to (and not smaller than) the average packet size. +" +! ! + +!Packet class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aPacket + ^ self new + bytes: aPacket bytes; + offset: aPacket headerSize + aPacket offset; + envelope: aPacket +! ! + +!Packet class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ nil +! ! + +!Packet class methodsFor: 'examples' stamp: 'KenD 28/Jun/2026 13:32:25'! +quake + " + EthernetPacket quake + " + ^ self bytes: #(0 224 125 133 118 7 0 80 218 114 237 208 8 0 69 0 0 60 80 84 0 0 128 17 227 192 192 168 66 201 192 168 66 130 108 253 109 6 0 40 151 16 37 205 0 0 145 44 0 0) +! ! + +!Packet class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +with: aPacket + ^ self with: aPacket headerSize: self headerSize +! ! + +!Packet class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +with: aPacketOrByteArray headerSize: anInteger + | answer | + (aPacketOrByteArray isKindOf: Packet) + ifFalse: [^ self bytes: aPacketOrByteArray offset: anInteger negated]. + + answer := self bytes: aPacketOrByteArray bytes offset: aPacketOrByteArray offset - anInteger. + aPacketOrByteArray envelope: answer. + ^ answer +! ! + +!Packet class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +with: aPacketOrByteArray headerSize: anInteger options: aCollection + | optionsSize answer index | + optionsSize := aCollection inject: 0 into: [ :count :each | count + each size]. + answer := self with: aPacketOrByteArray headerSize: anInteger + optionsSize + 1. + index := anInteger + 1. + aCollection do: [ :each | + answer replaceFrom: index to: index + each size - 1 with: each. + index := index + each size]. + answer at: index put: 0. + ^ answer +! ! + +!Packet class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +with: aPacket options: aCollection + ^ self with: aPacket headerSize: self headerSize options: aCollection +! ! + + +Packet initialize! + diff --git a/modules/NOS/Network/Packets/PacketOption.Class.st b/modules/NOS/Network/Packets/PacketOption.Class.st new file mode 100644 index 00000000..b918c426 --- /dev/null +++ b/modules/NOS/Network/Packets/PacketOption.Class.st @@ -0,0 +1,109 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #PacketOption category: 'SqueakNOS-Net-Packets'! +ArrayedCollection subclass: #PacketOption + instanceVariableNames: 'bytes offset' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger + ^ bytes at: anInteger + offset +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger put: anObject + ^ bytes at: anInteger + offset put: anObject +! ! + +!PacketOption methodsFor: 'accessing-private' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray + bytes := aByteArray +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + ^ self type > 1 ifTrue: [self at: 2] ifFalse: [1] +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length: anInteger + self at: 2 put: anInteger +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +longAt: anInteger + ^ (self shortAt: anInteger) * 16r10000 + (self shortAt: anInteger + 2) +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +longAt: anInteger put: aLong + self shortAt: anInteger put: aLong // 16r10000. + self shortAt: anInteger+2 put: aLong \\ 16r10000. + ^ aLong +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + ^ self type asString +! ! + +!PacketOption methodsFor: 'accessing-private' stamp: 'KenD 28/Jun/2026 13:32:25'! +offset: anInteger + offset := anInteger +! ! + +!PacketOption methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: '{', self name, '}' +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +shortAt: anInteger + ^ (self at: anInteger) * 256 + (self at: anInteger+1) +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +shortAt: anInteger put: aShort + self at: anInteger put: aShort // 256. + self at: anInteger+1 put: aShort \\ 256. + ^ aShort +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ self length +! ! + +!PacketOption methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +species + ^ ByteArray +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ self at: 1 +! ! + +!PacketOption methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type: anInteger + self at: 1 put: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PacketOption class' category: 'SqueakNOS-Net-Packets'! +PacketOption class + instanceVariableNames: ''! + +!PacketOption class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray + ^ self bytes: aByteArray offset: 0 +! ! + +!PacketOption class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray offset: anInteger + ^ self basicNew bytes: aByteArray; offset: anInteger +! ! + + diff --git a/modules/NOS/Network/Packets/RARPPacket.Class.st b/modules/NOS/Network/Packets/RARPPacket.Class.st new file mode 100644 index 00000000..2a9acd89 --- /dev/null +++ b/modules/NOS/Network/Packets/RARPPacket.Class.st @@ -0,0 +1,47 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #RARPPacket category: 'SqueakNOS-Net-Packets'! +ARPPacket subclass: #RARPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!RARPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isReply + ^ self opcode = 4 +! ! + +!RARPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isRequest + ^ self opcode = 3 +! ! + +!RARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +opcodeNames + ^ #(Unknown Unknown Request Reply) +! ! + +!RARPPacket methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: 'RARP '. + self isRequest + ifTrue: [aStream nextPutAll: 'who-is '; print: self targetHardwareAddress; nextPutAll: ' tell '; print: self senderHardwareAddress. + ^ self]. + self isReply + ifTrue: [aStream print: self targetProtocolAddress; nextPutAll: ' at '; print: self targetProtocolAddress. + ^ self]. + aStream nextPutAll: 'unknown opcode' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RARPPacket class' category: 'SqueakNOS-Net-Packets'! +RARPPacket class + instanceVariableNames: ''! + +!RARPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +etherType + ^ 16r8035 +! ! + + diff --git a/modules/NOS/Network/Packets/RDPPacket.Class.st b/modules/NOS/Network/Packets/RDPPacket.Class.st new file mode 100644 index 00000000..7622bcd4 --- /dev/null +++ b/modules/NOS/Network/Packets/RDPPacket.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #RDPPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #RDPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RDPPacket class' category: 'SqueakNOS-Net-Packets'! +RDPPacket class + instanceVariableNames: ''! + +!RDPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ 27 +! ! + + diff --git a/modules/NOS/Network/Packets/TCPPacket.Class.st b/modules/NOS/Network/Packets/TCPPacket.Class.st new file mode 100644 index 00000000..9137328f --- /dev/null +++ b/modules/NOS/Network/Packets/TCPPacket.Class.st @@ -0,0 +1,5547 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #TCPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!TCPPacket commentStamp: '' prior: 0! + +RFC: 793 + + + + + + + + TRANSMISSION CONTROL PROTOCOL + + + DARPA INTERNET PROGRAM + + PROTOCOL SPECIFICATION + + + + September 1981 + + + + + + + + + + + + + + prepared for + + Defense Advanced Research Projects Agency + Information Processing Techniques Office + 1400 Wilson Boulevard + Arlington, Virginia 22209 + + + + + + + + by + + Information Sciences Institute + University of Southern California + 4676 Admiralty Way + Marina del Rey, California 90291 + + + +September 1981 + Transmission Control Protocol + + + + TABLE OF CONTENTS + + PREFACE ........................................................ iii + +1. INTRODUCTION ..................................................... 1 + + 1.1 Motivation .................................................... 1 + 1.2 Scope ......................................................... 2 + 1.3 About This Document ........................................... 2 + 1.4 Interfaces .................................................... 3 + 1.5 Operation ..................................................... 3 + +2. PHILOSOPHY ....................................................... 7 + + 2.1 Elements of the Internetwork System ........................... 7 + 2.2 Model of Operation ............................................ 7 + 2.3 The Host Environment .......................................... 8 + 2.4 Interfaces .................................................... 9 + 2.5 Relation to Other Protocols ................................... 9 + 2.6 Reliable Communication ........................................ 9 + 2.7 Connection Establishment and Clearing ........................ 10 + 2.8 Data Communication ........................................... 12 + 2.9 Precedence and Security ...................................... 13 + 2.10 Robustness Principle ......................................... 13 + +3. FUNCTIONAL SPECIFICATION ........................................ 15 + + 3.1 Header Format ................................................ 15 + 3.2 Terminology .................................................. 19 + 3.3 Sequence Numbers ............................................. 24 + 3.4 Establishing a connection .................................... 30 + 3.5 Closing a Connection ......................................... 37 + 3.6 Precedence and Security ...................................... 40 + 3.7 Data Communication ........................................... 40 + 3.8 Interfaces ................................................... 44 + 3.9 Event Processing ............................................. 52 + +GLOSSARY ............................................................ 79 + +REFERENCES .......................................................... 85 + + + + + + + + + + + + [Page i] + + + September 1981 +Transmission Control Protocol + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Page ii] + + +September 1981 + Transmission Control Protocol + + + + PREFACE + + + +This document describes the DoD Standard Transmission Control Protocol +(TCP). There have been nine earlier editions of the ARPA TCP +specification on which this standard is based, and the present text +draws heavily from them. There have been many contributors to this work +both in terms of concepts and in terms of text. This edition clarifies +several details and removes the end-of-letter buffer-size adjustments, +and redescribes the letter mechanism as a push function. + + Jon Postel + + Editor + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + [Page iii] + + + + +RFC: 793 +Replaces: RFC 761 +IENs: 129, 124, 112, 81, +55, 44, 40, 27, 21, 5 + + TRANSMISSION CONTROL PROTOCOL + + DARPA INTERNET PROGRAM + PROTOCOL SPECIFICATION + + + + 1. INTRODUCTION + +The Transmission Control Protocol (TCP) is intended for use as a highly +reliable host-to-host protocol between hosts in packet-switched computer +communication networks, and in interconnected systems of such networks. + +This document describes the functions to be performed by the +Transmission Control Protocol, the program that implements it, and its +interface to programs or users that require its services. + +1.1. Motivation + + Computer communication systems are playing an increasingly important + role in military, government, and civilian environments. This + document focuses its attention primarily on military computer + communication requirements, especially robustness in the presence of + communication unreliability and availability in the presence of + congestion, but many of these problems are found in the civilian and + government sector as well. + + As strategic and tactical computer communication networks are + developed and deployed, it is essential to provide means of + interconnecting them and to provide standard interprocess + communication protocols which can support a broad range of + applications. In anticipation of the need for such standards, the + Deputy Undersecretary of Defense for Research and Engineering has + declared the Transmission Control Protocol (TCP) described herein to + be a basis for DoD-wide inter-process communication protocol + standardization. + + TCP is a connection-oriented, end-to-end reliable protocol designed to + fit into a layered hierarchy of protocols which support multi-network + applications. The TCP provides for reliable inter-process + communication between pairs of processes in host computers attached to + distinct but interconnected computer communication networks. Very few + assumptions are made as to the reliability of the communication + protocols below the TCP layer. TCP assumes it can obtain a simple, + potentially unreliable datagram service from the lower level + protocols. In principle, the TCP should be able to operate above a + wide spectrum of communication systems ranging from hard-wired + connections to packet-switched or circuit-switched networks. + + + [Page 1] + + + September 1981 +Transmission Control Protocol +Introduction + + + + TCP is based on concepts first described by Cerf and Kahn in [1]. The + TCP fits into a layered protocol architecture just above a basic + Internet Protocol [2] which provides a way for the TCP to send and + receive variable-length segments of information enclosed in internet + datagram "envelopes". The internet datagram provides a means for + addressing source and destination TCPs in different networks. The + internet protocol also deals with any fragmentation or reassembly of + the TCP segments required to achieve transport and delivery through + multiple networks and interconnecting gateways. The internet protocol + also carries information on the precedence, security classification + and compartmentation of the TCP segments, so this information can be + communicated end-to-end across multiple networks. + + Protocol Layering + + +---------------------+ + | higher-level | + +---------------------+ + | TCP | + +---------------------+ + | internet protocol | + +---------------------+ + |communication network| + +---------------------+ + + Figure 1 + + Much of this document is written in the context of TCP implementations + which are co-resident with higher level protocols in the host + computer. Some computer systems will be connected to networks via + front-end computers which house the TCP and internet protocol layers, + as well as network specific software. The TCP specification describes + an interface to the higher level protocols which appears to be + implementable even for the front-end case, as long as a suitable + host-to-front end protocol is implemented. + +1.2. Scope + + The TCP is intended to provide a reliable process-to-process + communication service in a multinetwork environment. The TCP is + intended to be a host-to-host protocol in common use in multiple + networks. + +1.3. About this Document + + This document represents a specification of the behavior required of + any TCP implementation, both in its interactions with higher level + protocols and in its interactions with other TCPs. The rest of this + + +[Page 2] + + +September 1981 + Transmission Control Protocol + Introduction + + + + section offers a very brief view of the protocol interfaces and + operation. Section 2 summarizes the philosophical basis for the TCP + design. Section 3 offers both a detailed description of the actions + required of TCP when various events occur (arrival of new segments, + user calls, errors, etc.) and the details of the formats of TCP + segments. + +1.4. Interfaces + + The TCP interfaces on one side to user or application processes and on + the other side to a lower level protocol such as Internet Protocol. + + The interface between an application process and the TCP is + illustrated in reasonable detail. This interface consists of a set of + calls much like the calls an operating system provides to an + application process for manipulating files. For example, there are + calls to open and close connections and to send and receive data on + established connections. It is also expected that the TCP can + asynchronously communicate with application programs. Although + considerable freedom is permitted to TCP implementors to design + interfaces which are appropriate to a particular operating system + environment, a minimum functionality is required at the TCP/user + interface for any valid implementation. + + The interface between TCP and lower level protocol is essentially + unspecified except that it is assumed there is a mechanism whereby the + two levels can asynchronously pass information to each other. + Typically, one expects the lower level protocol to specify this + interface. TCP is designed to work in a very general environment of + interconnected networks. The lower level protocol which is assumed + throughout this document is the Internet Protocol [2]. + +1.5. Operation + + As noted above, the primary purpose of the TCP is to provide reliable, + securable logical circuit or connection service between pairs of + processes. To provide this service on top of a less reliable internet + communication system requires facilities in the following areas: + + Basic Data Transfer + Reliability + Flow Control + Multiplexing + Connections + Precedence and Security + + The basic operation of the TCP in each of these areas is described in + the following paragraphs. + + + [Page 3] + + + September 1981 +Transmission Control Protocol +Introduction + + + + Basic Data Transfer: + + The TCP is able to transfer a continuous stream of octets in each + direction between its users by packaging some number of octets into + segments for transmission through the internet system. In general, + the TCPs decide when to block and forward data at their own + convenience. + + Sometimes users need to be sure that all the data they have + submitted to the TCP has been transmitted. For this purpose a push + function is defined. To assure that data submitted to a TCP is + actually transmitted the sending user indicates that it should be + pushed through to the receiving user. A push causes the TCPs to + promptly forward and deliver data up to that point to the receiver. + The exact push point might not be visible to the receiving user and + the push function does not supply a record boundary marker. + + Reliability: + + The TCP must recover from data that is damaged, lost, duplicated, or + delivered out of order by the internet communication system. This + is achieved by assigning a sequence number to each octet + transmitted, and requiring a positive acknowledgment (ACK) from the + receiving TCP. If the ACK is not received within a timeout + interval, the data is retransmitted. At the receiver, the sequence + numbers are used to correctly order segments that may be received + out of order and to eliminate duplicates. Damage is handled by + adding a checksum to each segment transmitted, checking it at the + receiver, and discarding damaged segments. + + As long as the TCPs continue to function properly and the internet + system does not become completely partitioned, no transmission + errors will affect the correct delivery of data. TCP recovers from + internet communication system errors. + + Flow Control: + + TCP provides a means for the receiver to govern the amount of data + sent by the sender. This is achieved by returning a "window" with + every ACK indicating a range of acceptable sequence numbers beyond + the last segment successfully received. The window indicates an + allowed number of octets that the sender may transmit before + receiving further permission. + + + + + + + +[Page 4] + + +September 1981 + Transmission Control Protocol + Introduction + + + + Multiplexing: + + To allow for many processes within a single Host to use TCP + communication facilities simultaneously, the TCP provides a set of + addresses or ports within each host. Concatenated with the network + and host addresses from the internet communication layer, this forms + a socket. A pair of sockets uniquely identifies each connection. + That is, a socket may be simultaneously used in multiple + connections. + + The binding of ports to processes is handled independently by each + Host. However, it proves useful to attach frequently used processes + (e.g., a "logger" or timesharing service) to fixed sockets which are + made known to the public. These services can then be accessed + through the known addresses. Establishing and learning the port + addresses of other processes may involve more dynamic mechanisms. + + Connections: + + The reliability and flow control mechanisms described above require + that TCPs initialize and maintain certain status information for + each data stream. The combination of this information, including + sockets, sequence numbers, and window sizes, is called a connection. + Each connection is uniquely specified by a pair of sockets + identifying its two sides. + + When two processes wish to communicate, their TCP's must first + establish a connection (initialize the status information on each + side). When their communication is complete, the connection is + terminated or closed to free the resources for other uses. + + Since connections must be established between unreliable hosts and + over the unreliable internet communication system, a handshake + mechanism with clock-based sequence numbers is used to avoid + erroneous initialization of connections. + + Precedence and Security: + + The users of TCP may indicate the security and precedence of their + communication. Provision is made for default values to be used when + these features are not needed. + + + + + + + + + + [Page 5] + + + September 1981 +Transmission Control Protocol + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Page 6] + + +September 1981 + Transmission Control Protocol + + + + 2. PHILOSOPHY + +2.1. Elements of the Internetwork System + + The internetwork environment consists of hosts connected to networks + which are in turn interconnected via gateways. It is assumed here + that the networks may be either local networks (e.g., the ETHERNET) or + large networks (e.g., the ARPANET), but in any case are based on + packet switching technology. The active agents that produce and + consume messages are processes. Various levels of protocols in the + networks, the gateways, and the hosts support an interprocess + communication system that provides two-way data flow on logical + connections between process ports. + + The term packet is used generically here to mean the data of one + transaction between a host and its network. The format of data blocks + exchanged within the a network will generally not be of concern to us. + + Hosts are computers attached to a network, and from the communication + network's point of view, are the sources and destinations of packets. + Processes are viewed as the active elements in host computers (in + accordance with the fairly common definition of a process as a program + in execution). Even terminals and files or other I/O devices are + viewed as communicating with each other through the use of processes. + Thus, all communication is viewed as inter-process communication. + + Since a process may need to distinguish among several communication + streams between itself and another process (or processes), we imagine + that each process may have a number of ports through which it + communicates with the ports of other processes. + +2.2. Model of Operation + + Processes transmit data by calling on the TCP and passing buffers of + data as arguments. The TCP packages the data from these buffers into + segments and calls on the internet module to transmit each segment to + the destination TCP. The receiving TCP places the data from a segment + into the receiving user's buffer and notifies the receiving user. The + TCPs include control information in the segments which they use to + ensure reliable ordered data transmission. + + The model of internet communication is that there is an internet + protocol module associated with each TCP which provides an interface + to the local network. This internet module packages TCP segments + inside internet datagrams and routes these datagrams to a destination + internet module or intermediate gateway. To transmit the datagram + through the local network, it is embedded in a local network packet. + + The packet switches may perform further packaging, fragmentation, or + + + [Page 7] + + + September 1981 +Transmission Control Protocol +Philosophy + + + + other operations to achieve the delivery of the local packet to the + destination internet module. + + At a gateway between networks, the internet datagram is "unwrapped" + from its local packet and examined to determine through which network + the internet datagram should travel next. The internet datagram is + then "wrapped" in a local packet suitable to the next network and + routed to the next gateway, or to the final destination. + + A gateway is permitted to break up an internet datagram into smaller + internet datagram fragments if this is necessary for transmission + through the next network. To do this, the gateway produces a set of + internet datagrams; each carrying a fragment. Fragments may be + further broken into smaller fragments at subsequent gateways. The + internet datagram fragment format is designed so that the destination + internet module can reassemble fragments into internet datagrams. + + A destination internet module unwraps the segment from the datagram + (after reassembling the datagram, if necessary) and passes it to the + destination TCP. + + This simple model of the operation glosses over many details. One + important feature is the type of service. This provides information + to the gateway (or internet module) to guide it in selecting the + service parameters to be used in traversing the next network. + Included in the type of service information is the precedence of the + datagram. Datagrams may also carry security information to permit + host and gateways that operate in multilevel secure environments to + properly segregate datagrams for security considerations. + +2.3. The Host Environment + + The TCP is assumed to be a module in an operating system. The users + access the TCP much like they would access the file system. The TCP + may call on other operating system functions, for example, to manage + data structures. The actual interface to the network is assumed to be + controlled by a device driver module. The TCP does not call on the + network device driver directly, but rather calls on the internet + datagram protocol module which may in turn call on the device driver. + + The mechanisms of TCP do not preclude implementation of the TCP in a + front-end processor. However, in such an implementation, a + host-to-front-end protocol must provide the functionality to support + the type of TCP-user interface described in this document. + + + + + + +[Page 8] + + +September 1981 + Transmission Control Protocol + Philosophy + + + +2.4. Interfaces + + The TCP/user interface provides for calls made by the user on the TCP + to OPEN or CLOSE a connection, to SEND or RECEIVE data, or to obtain + STATUS about a connection. These calls are like other calls from user + programs on the operating system, for example, the calls to open, read + from, and close a file. + + The TCP/internet interface provides calls to send and receive + datagrams addressed to TCP modules in hosts anywhere in the internet + system. These calls have parameters for passing the address, type of + service, precedence, security, and other control information. + +2.5. Relation to Other Protocols + + The following diagram illustrates the place of the TCP in the protocol + hierarchy: + + + +------+ +-----+ +-----+ +-----+ + |Telnet| | FTP | |Voice| ... | | Application Level + +------+ +-----+ +-----+ +-----+ + | | | | + +-----+ +-----+ +-----+ + | TCP | | RTP | ... | | Host Level + +-----+ +-----+ +-----+ + | | | + +-------------------------------+ + | Internet Protocol & ICMP | Gateway Level + +-------------------------------+ + | + +---------------------------+ + | Local Network Protocol | Network Level + +---------------------------+ + + Protocol Relationships + + Figure 2. + + It is expected that the TCP will be able to support higher level + protocols efficiently. It should be easy to interface higher level + protocols like the ARPANET Telnet or AUTODIN II THP to the TCP. + +2.6. Reliable Communication + + A stream of data sent on a TCP connection is delivered reliably and in + order at the destination. + + + + [Page 9] + + + September 1981 +Transmission Control Protocol +Philosophy + + + + Transmission is made reliable via the use of sequence numbers and + acknowledgments. Conceptually, each octet of data is assigned a + sequence number. The sequence number of the first octet of data in a + segment is transmitted with that segment and is called the segment + sequence number. Segments also carry an acknowledgment number which + is the sequence number of the next expected data octet of + transmissions in the reverse direction. When the TCP transmits a + segment containing data, it puts a copy on a retransmission queue and + starts a timer; when the acknowledgment for that data is received, the + segment is deleted from the queue. If the acknowledgment is not + received before the timer runs out, the segment is retransmitted. + + An acknowledgment by TCP does not guarantee that the data has been + delivered to the end user, but only that the receiving TCP has taken + the responsibility to do so. + + To govern the flow of data between TCPs, a flow control mechanism is + employed. The receiving TCP reports a "window" to the sending TCP. + This window specifies the number of octets, starting with the + acknowledgment number, that the receiving TCP is currently prepared to + receive. + +2.7. Connection Establishment and Clearing + + To identify the separate data streams that a TCP may handle, the TCP + provides a port identifier. Since port identifiers are selected + independently by each TCP they might not be unique. To provide for + unique addresses within each TCP, we concatenate an internet address + identifying the TCP with a port identifier to create a socket which + will be unique throughout all networks connected together. + + A connection is fully specified by the pair of sockets at the ends. A + local socket may participate in many connections to different foreign + sockets. A connection can be used to carry data in both directions, + that is, it is "full duplex". + + TCPs are free to associate ports with processes however they choose. + However, several basic concepts are necessary in any implementation. + There must be well-known sockets which the TCP associates only with + the "appropriate" processes by some means. We envision that processes + may "own" ports, and that processes can initiate connections only on + the ports they own. (Means for implementing ownership is a local + issue, but we envision a Request Port user command, or a method of + uniquely allocating a group of ports to a given process, e.g., by + associating the high order bits of a port name with a given process.) + + A connection is specified in the OPEN call by the local port and + foreign socket arguments. In return, the TCP supplies a (short) local + + +[Page 10] + + +September 1981 + Transmission Control Protocol + Philosophy + + + + connection name by which the user refers to the connection in + subsequent calls. There are several things that must be remembered + about a connection. To store this information we imagine that there + is a data structure called a Transmission Control Block (TCB). One + implementation strategy would have the local connection name be a + pointer to the TCB for this connection. The OPEN call also specifies + whether the connection establishment is to be actively pursued, or to + be passively waited for. + + A passive OPEN request means that the process wants to accept incoming + connection requests rather than attempting to initiate a connection. + Often the process requesting a passive OPEN will accept a connection + request from any caller. In this case a foreign socket of all zeros + is used to denote an unspecified socket. Unspecified foreign sockets + are allowed only on passive OPENs. + + A service process that wished to provide services for unknown other + processes would issue a passive OPEN request with an unspecified + foreign socket. Then a connection could be made with any process that + requested a connection to this local socket. It would help if this + local socket were known to be associated with this service. + + Well-known sockets are a convenient mechanism for a priori associating + a socket address with a standard service. For instance, the + "Telnet-Server" process is permanently assigned to a particular + socket, and other sockets are reserved for File Transfer, Remote Job + Entry, Text Generator, Echoer, and Sink processes (the last three + being for test purposes). A socket address might be reserved for + access to a "Look-Up" service which would return the specific socket + at which a newly created service would be provided. The concept of a + well-known socket is part of the TCP specification, but the assignment + of sockets to services is outside this specification. (See [4].) + + Processes can issue passive OPENs and wait for matching active OPENs + from other processes and be informed by the TCP when connections have + been established. Two processes which issue active OPENs to each + other at the same time will be correctly connected. This flexibility + is critical for the support of distributed computing in which + components act asynchronously with respect to each other. + + There are two principal cases for matching the sockets in the local + passive OPENs and an foreign active OPENs. In the first case, the + local passive OPENs has fully specified the foreign socket. In this + case, the match must be exact. In the second case, the local passive + OPENs has left the foreign socket unspecified. In this case, any + foreign socket is acceptable as long as the local sockets match. + Other possibilities include partially restricted matches. + + + + [Page 11] + + + September 1981 +Transmission Control Protocol +Philosophy + + + + If there are several pending passive OPENs (recorded in TCBs) with the + same local socket, an foreign active OPEN will be matched to a TCB + with the specific foreign socket in the foreign active OPEN, if such a + TCB exists, before selecting a TCB with an unspecified foreign socket. + + The procedures to establish connections utilize the synchronize (SYN) + control flag and involves an exchange of three messages. This + exchange has been termed a three-way hand shake [3]. + + A connection is initiated by the rendezvous of an arriving segment + containing a SYN and a waiting TCB entry each created by a user OPEN + command. The matching of local and foreign sockets determines when a + connection has been initiated. The connection becomes "established" + when sequence numbers have been synchronized in both directions. + + The clearing of a connection also involves the exchange of segments, + in this case carrying the FIN control flag. + +2.8. Data Communication + + The data that flows on a connection may be thought of as a stream of + octets. The sending user indicates in each SEND call whether the data + in that call (and any preceeding calls) should be immediately pushed + through to the receiving user by the setting of the PUSH flag. + + A sending TCP is allowed to collect data from the sending user and to + send that data in segments at its own convenience, until the push + function is signaled, then it must send all unsent data. When a + receiving TCP sees the PUSH flag, it must not wait for more data from + the sending TCP before passing the data to the receiving process. + + There is no necessary relationship between push functions and segment + boundaries. The data in any particular segment may be the result of a + single SEND call, in whole or part, or of multiple SEND calls. + + The purpose of push function and the PUSH flag is to push data through + from the sending user to the receiving user. It does not provide a + record service. + + There is a coupling between the push function and the use of buffers + of data that cross the TCP/user interface. Each time a PUSH flag is + associated with data placed into the receiving user's buffer, the + buffer is returned to the user for processing even if the buffer is + not filled. If data arrives that fills the user's buffer before a + PUSH is seen, the data is passed to the user in buffer size units. + + TCP also provides a means to communicate to the receiver of data that + at some point further along in the data stream than the receiver is + + +[Page 12] + + +September 1981 + Transmission Control Protocol + Philosophy + + + + currently reading there is urgent data. TCP does not attempt to + define what the user specifically does upon being notified of pending + urgent data, but the general notion is that the receiving process will + take action to process the urgent data quickly. + +2.9. Precedence and Security + + The TCP makes use of the internet protocol type of service field and + security option to provide precedence and security on a per connection + basis to TCP users. Not all TCP modules will necessarily function in + a multilevel secure environment; some may be limited to unclassified + use only, and others may operate at only one security level and + compartment. Consequently, some TCP implementations and services to + users may be limited to a subset of the multilevel secure case. + + TCP modules which operate in a multilevel secure environment must + properly mark outgoing segments with the security, compartment, and + precedence. Such TCP modules must also provide to their users or + higher level protocols such as Telnet or THP an interface to allow + them to specify the desired security level, compartment, and + precedence of connections. + +2.10. Robustness Principle + + TCP implementations will follow a general principle of robustness: be + conservative in what you do, be liberal in what you accept from + others. + + + + + + + + + + + + + + + + + + + + + + + + [Page 13] + + + September 1981 +Transmission Control Protocol + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Page 14] + + +September 1981 + Transmission Control Protocol + + + + 3. FUNCTIONAL SPECIFICATION + +3.1. Header Format + + TCP segments are sent as internet datagrams. The Internet Protocol + header carries several information fields, including the source and + destination host addresses [2]. A TCP header follows the internet + header, supplying information specific to the TCP protocol. This + division allows for the existence of host level protocols other than + TCP. + + TCP Header Format + + + 0 1 2 3 + 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Source Port | Destination Port | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Sequence Number | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Acknowledgment Number | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Data | |U|A|P|R|S|F| | + | Offset | Reserved |R|C|S| S|Y|I| Window | + | | |G|K|H|T|N|N| | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Checksum | Urgent Pointer | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | Options | Padding | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + | data | + +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + + TCP Header Format + + Note that one tick mark represents one bit position. + + Figure 3. + + Source Port: 16 bits + + The source port number. + + Destination Port: 16 bits + + The destination port number. + + + + + [Page 15] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + Sequence Number: 32 bits + + The sequence number of the first data octet in this segment (except + when SYN is present). If SYN is present the sequence number is the + initial sequence number (ISN) and the first data octet is ISN+1. + + Acknowledgment Number: 32 bits + + If the ACK control bit is set this field contains the value of the + next sequence number the sender of the segment is expecting to + receive. Once a connection is established this is always sent. + + Data Offset: 4 bits + + The number of 32 bit words in the TCP Header. This indicates where + the data begins. The TCP header (even one including options) is an + integral number of 32 bits long. + + Reserved: 6 bits + + Reserved for future use. Must be zero. + + Control Bits: 6 bits (from left to right): + + URG: Urgent Pointer field significant + ACK: Acknowledgment field significant + PSH: Push Function + RST: Reset the connection + SYN: Synchronize sequence numbers + FIN: No more data from sender + + Window: 16 bits + + The number of data octets beginning with the one indicated in the + acknowledgment field which the sender of this segment is willing to + accept. + + Checksum: 16 bits + + The checksum field is the 16 bit one's complement of the one's + complement sum of all 16 bit words in the header and text. If a + segment contains an odd number of header and text octets to be + checksummed, the last octet is padded on the right with zeros to + form a 16 bit word for checksum purposes. The pad is not + transmitted as part of the segment. While computing the checksum, + the checksum field itself is replaced with zeros. + + The checksum also covers a 96 bit pseudo header conceptually + + +[Page 16] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + prefixed to the TCP header. This pseudo header contains the Source + Address, the Destination Address, the Protocol, and TCP length. + This gives the TCP protection against misrouted segments. This + information is carried in the Internet Protocol and is transferred + across the TCP/Network interface in the arguments or results of + calls by the TCP on the IP. + + +--------+--------+--------+--------+ + | Source Address | + +--------+--------+--------+--------+ + | Destination Address | + +--------+--------+--------+--------+ + | zero | PTCL | TCP Length | + +--------+--------+--------+--------+ + + The TCP Length is the TCP header length plus the data length in + octets (this is not an explicitly transmitted quantity, but is + computed), and it does not count the 12 octets of the pseudo + header. + + Urgent Pointer: 16 bits + + This field communicates the current value of the urgent pointer as a + positive offset from the sequence number in this segment. The + urgent pointer points to the sequence number of the octet following + the urgent data. This field is only be interpreted in segments with + the URG control bit set. + + Options: variable + + Options may occupy space at the end of the TCP header and are a + multiple of 8 bits in length. All options are included in the + checksum. An option may begin on any octet boundary. There are two + cases for the format of an option: + + Case 1: A single octet of option-kind. + + Case 2: An octet of option-kind, an octet of option-length, and + the actual option-data octets. + + The option-length counts the two octets of option-kind and + option-length as well as the option-data octets. + + Note that the list of options may be shorter than the data offset + field might imply. The content of the header beyond the + End-of-Option option must be header padding (i.e., zero). + + A TCP must implement all options. + + + [Page 17] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + Currently defined options include (kind indicated in octal): + + Kind Length Meaning + ---- ------ ------- + 0 - End of option list. + 1 - No-Operation. + 2 4 Maximum Segment Size. + + + Specific Option Definitions + + End of Option List + + +--------+ + |00000000| + +--------+ + Kind=0 + + This option code indicates the end of the option list. This + might not coincide with the end of the TCP header according to + the Data Offset field. This is used at the end of all options, + not the end of each option, and need only be used if the end of + the options would not otherwise coincide with the end of the TCP + header. + + No-Operation + + +--------+ + |00000001| + +--------+ + Kind=1 + + This option code may be used between options, for example, to + align the beginning of a subsequent option on a word boundary. + There is no guarantee that senders will use this option, so + receivers must be prepared to process options even if they do + not begin on a word boundary. + + Maximum Segment Size + + +--------+--------+---------+--------+ + |00000010|00000100| max seg size | + +--------+--------+---------+--------+ + Kind=2 Length=4 + + + + + + +[Page 18] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + Maximum Segment Size Option Data: 16 bits + + If this option is present, then it communicates the maximum + receive segment size at the TCP which sends this segment. + This field must only be sent in the initial connection request + (i.e., in segments with the SYN control bit set). If this + option is not used, any segment size is allowed. + + Padding: variable + + The TCP header padding is used to ensure that the TCP header ends + and data begins on a 32 bit boundary. The padding is composed of + zeros. + +3.2. Terminology + + Before we can discuss very much about the operation of the TCP we need + to introduce some detailed terminology. The maintenance of a TCP + connection requires the remembering of several variables. We conceive + of these variables being stored in a connection record called a + Transmission Control Block or TCB. Among the variables stored in the + TCB are the local and remote socket numbers, the security and + precedence of the connection, pointers to the user's send and receive + buffers, pointers to the retransmit queue and to the current segment. + In addition several variables relating to the send and receive + sequence numbers are stored in the TCB. + + Send Sequence Variables + + SND.UNA - send unacknowledged + SND.NXT - send next + SND.WND - send window + SND.UP - send urgent pointer + SND.WL1 - segment sequence number used for last window update + SND.WL2 - segment acknowledgment number used for last window + update + ISS - initial send sequence number + + Receive Sequence Variables + + RCV.NXT - receive next + RCV.WND - receive window + RCV.UP - receive urgent pointer + IRS - initial receive sequence number + + + + + + + [Page 19] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + The following diagrams may help to relate some of these variables to + the sequence space. + + Send Sequence Space + + 1 2 3 4 + ----------|----------|----------|---------- + SND.UNA SND.NXT SND.UNA + +SND.WND + + 1 - old sequence numbers which have been acknowledged + 2 - sequence numbers of unacknowledged data + 3 - sequence numbers allowed for new data transmission + 4 - future sequence numbers which are not yet allowed + + Send Sequence Space + + Figure 4. + + + + The send window is the portion of the sequence space labeled 3 in + figure 4. + + Receive Sequence Space + + 1 2 3 + ----------|----------|---------- + RCV.NXT RCV.NXT + +RCV.WND + + 1 - old sequence numbers which have been acknowledged + 2 - sequence numbers allowed for new reception + 3 - future sequence numbers which are not yet allowed + + Receive Sequence Space + + Figure 5. + + + + The receive window is the portion of the sequence space labeled 2 in + figure 5. + + There are also some variables used frequently in the discussion that + take their values from the fields of the current segment. + + + + +[Page 20] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + Current Segment Variables + + SEG.SEQ - segment sequence number + SEG.ACK - segment acknowledgment number + SEG.LEN - segment length + SEG.WND - segment window + SEG.UP - segment urgent pointer + SEG.PRC - segment precedence value + + A connection progresses through a series of states during its + lifetime. The states are: LISTEN, SYN-SENT, SYN-RECEIVED, + ESTABLISHED, FIN-WAIT-1, FIN-WAIT-2, CLOSE-WAIT, CLOSING, LAST-ACK, + TIME-WAIT, and the fictional state CLOSED. CLOSED is fictional + because it represents the state when there is no TCB, and therefore, + no connection. Briefly the meanings of the states are: + + LISTEN - represents waiting for a connection request from any remote + TCP and port. + + SYN-SENT - represents waiting for a matching connection request + after having sent a connection request. + + SYN-RECEIVED - represents waiting for a confirming connection + request acknowledgment after having both received and sent a + connection request. + + ESTABLISHED - represents an open connection, data received can be + delivered to the user. The normal state for the data transfer phase + of the connection. + + FIN-WAIT-1 - represents waiting for a connection termination request + from the remote TCP, or an acknowledgment of the connection + termination request previously sent. + + FIN-WAIT-2 - represents waiting for a connection termination request + from the remote TCP. + + CLOSE-WAIT - represents waiting for a connection termination request + from the local user. + + CLOSING - represents waiting for a connection termination request + acknowledgment from the remote TCP. + + LAST-ACK - represents waiting for an acknowledgment of the + connection termination request previously sent to the remote TCP + (which includes an acknowledgment of its connection termination + request). + + + + [Page 21] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + TIME-WAIT - represents waiting for enough time to pass to be sure + the remote TCP received the acknowledgment of its connection + termination request. + + CLOSED - represents no connection state at all. + + A TCP connection progresses from one state to another in response to + events. The events are the user calls, OPEN, SEND, RECEIVE, CLOSE, + ABORT, and STATUS; the incoming segments, particularly those + containing the SYN, ACK, RST and FIN flags; and timeouts. + + The state diagram in figure 6 illustrates only state changes, together + with the causing events and resulting actions, but addresses neither + error conditions nor actions which are not connected with state + changes. In a later section, more detail is offered with respect to + the reaction of the TCP to events. + + NOTE BENE: this diagram is only a summary and must not be taken as + the total specification. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Page 22] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + + +---------+ ---------\ active OPEN + | CLOSED | \ ----------- + +---------+<---------\ \ create TCB + | ^ \ \ snd SYN + passive OPEN | | CLOSE \ \ + ------------ | | ---------- \ \ + create TCB | | delete TCB \ \ + V | \ \ + +---------+ CLOSE | \ + | LISTEN | ---------- | | + +---------+ delete TCB | | + rcv SYN | | SEND | | + ----------- | | ------- | V + +---------+ snd SYN,ACK / \ snd SYN +---------+ + | |<----------------- ------------------>| | + | SYN | rcv SYN | SYN | + | RCVD |<-----------------------------------------------| SENT | + | | snd ACK | | + | |------------------ -------------------| | + +---------+ rcv ACK of SYN \ / rcv SYN,ACK +---------+ + | -------------- | | ----------- + | x | | snd ACK + | V V + | CLOSE +---------+ + | ------- | ESTAB | + | snd FIN +---------+ + | CLOSE | | rcv FIN + V ------- | | ------- + +---------+ snd FIN / \ snd ACK +---------+ + | FIN |<----------------- ------------------>| CLOSE | + | WAIT-1 |------------------ | WAIT | + +---------+ rcv FIN \ +---------+ + | rcv ACK of FIN ------- | CLOSE | + | -------------- snd ACK | ------- | + V x V snd FIN V + +---------+ +---------+ +---------+ + |FINWAIT-2| | CLOSING | | LAST-ACK| + +---------+ +---------+ +---------+ + | rcv ACK of FIN | rcv ACK of FIN | + | rcv FIN -------------- | Timeout=2MSL -------------- | + | ------- x V ------------ x V + \ snd ACK +---------+delete TCB +---------+ + ------------------------>|TIME WAIT|------------------>| CLOSED | + +---------+ +---------+ + + TCP Connection State Diagram + Figure 6. + + + [Page 23] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + +3.3. Sequence Numbers + + A fundamental notion in the design is that every octet of data sent + over a TCP connection has a sequence number. Since every octet is + sequenced, each of them can be acknowledged. The acknowledgment + mechanism employed is cumulative so that an acknowledgment of sequence + number X indicates that all octets up to but not including X have been + received. This mechanism allows for straight-forward duplicate + detection in the presence of retransmission. Numbering of octets + within a segment is that the first data octet immediately following + the header is the lowest numbered, and the following octets are + numbered consecutively. + + It is essential to remember that the actual sequence number space is + finite, though very large. This space ranges from 0 to 2**32 - 1. + Since the space is finite, all arithmetic dealing with sequence + numbers must be performed modulo 2**32. This unsigned arithmetic + preserves the relationship of sequence numbers as they cycle from + 2**32 - 1 to 0 again. There are some subtleties to computer modulo + arithmetic, so great care should be taken in programming the + comparison of such values. The symbol "=<" means "less than or equal" + (modulo 2**32). + + The typical kinds of sequence number comparisons which the TCP must + perform include: + + (a) Determining that an acknowledgment refers to some sequence + number sent but not yet acknowledged. + + (b) Determining that all sequence numbers occupied by a segment + have been acknowledged (e.g., to remove the segment from a + retransmission queue). + + (c) Determining that an incoming segment contains sequence numbers + which are expected (i.e., that the segment "overlaps" the + receive window). + + + + + + + + + + + + + + +[Page 24] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + In response to sending data the TCP will receive acknowledgments. The + following comparisons are needed to process the acknowledgments. + + SND.UNA = oldest unacknowledged sequence number + + SND.NXT = next sequence number to be sent + + SEG.ACK = acknowledgment from the receiving TCP (next sequence + number expected by the receiving TCP) + + SEG.SEQ = first sequence number of a segment + + SEG.LEN = the number of octets occupied by the data in the segment + (counting SYN and FIN) + + SEG.SEQ+SEG.LEN-1 = last sequence number of a segment + + A new acknowledgment (called an "acceptable ack"), is one for which + the inequality below holds: + + SND.UNA < SEG.ACK =< SND.NXT + + A segment on the retransmission queue is fully acknowledged if the sum + of its sequence number and length is less or equal than the + acknowledgment value in the incoming segment. + + When data is received the following comparisons are needed: + + RCV.NXT = next sequence number expected on an incoming segments, and + is the left or lower edge of the receive window + + RCV.NXT+RCV.WND-1 = last sequence number expected on an incoming + segment, and is the right or upper edge of the receive window + + SEG.SEQ = first sequence number occupied by the incoming segment + + SEG.SEQ+SEG.LEN-1 = last sequence number occupied by the incoming + segment + + A segment is judged to occupy a portion of valid receive sequence + space if + + RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND + + or + + RCV.NXT =< SEG.SEQ+SEG.LEN-1 < RCV.NXT+RCV.WND + + + + [Page 25] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + The first part of this test checks to see if the beginning of the + segment falls in the window, the second part of the test checks to see + if the end of the segment falls in the window; if the segment passes + either part of the test it contains data in the window. + + Actually, it is a little more complicated than this. Due to zero + windows and zero length segments, we have four cases for the + acceptability of an incoming segment: + + Segment Receive Test + Length Window + ------- ------- ------------------------------------------- + + 0 0 SEG.SEQ = RCV.NXT + + 0 >0 RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND + + >0 0 not acceptable + + >0 >0 RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND + or RCV.NXT =< SEG.SEQ+SEG.LEN-1 < RCV.NXT+RCV.WND + + Note that when the receive window is zero no segments should be + acceptable except ACK segments. Thus, it is be possible for a TCP to + maintain a zero receive window while transmitting data and receiving + ACKs. However, even when the receive window is zero, a TCP must + process the RST and URG fields of all incoming segments. + + We have taken advantage of the numbering scheme to protect certain + control information as well. This is achieved by implicitly including + some control flags in the sequence space so they can be retransmitted + and acknowledged without confusion (i.e., one and only one copy of the + control will be acted upon). Control information is not physically + carried in the segment data space. Consequently, we must adopt rules + for implicitly assigning sequence numbers to control. The SYN and FIN + are the only controls requiring this protection, and these controls + are used only at connection opening and closing. For sequence number + purposes, the SYN is considered to occur before the first actual data + octet of the segment in which it occurs, while the FIN is considered + to occur after the last actual data octet in a segment in which it + occurs. The segment length (SEG.LEN) includes both data and sequence + space occupying controls. When a SYN is present then SEG.SEQ is the + sequence number of the SYN. + + + + + + + +[Page 26] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + Initial Sequence Number Selection + + The protocol places no restriction on a particular connection being + used over and over again. A connection is defined by a pair of + sockets. New instances of a connection will be referred to as + incarnations of the connection. The problem that arises from this is + -- "how does the TCP identify duplicate segments from previous + incarnations of the connection?" This problem becomes apparent if the + connection is being opened and closed in quick succession, or if the + connection breaks with loss of memory and is then reestablished. + + To avoid confusion we must prevent segments from one incarnation of a + connection from being used while the same sequence numbers may still + be present in the network from an earlier incarnation. We want to + assure this, even if a TCP crashes and loses all knowledge of the + sequence numbers it has been using. When new connections are created, + an initial sequence number (ISN) generator is employed which selects a + new 32 bit ISN. The generator is bound to a (possibly fictitious) 32 + bit clock whose low order bit is incremented roughly every 4 + microseconds. Thus, the ISN cycles approximately every 4.55 hours. + Since we assume that segments will stay in the network no more than + the Maximum Segment Lifetime (MSL) and that the MSL is less than 4.55 + hours we can reasonably assume that ISN's will be unique. + + For each connection there is a send sequence number and a receive + sequence number. The initial send sequence number (ISS) is chosen by + the data sending TCP, and the initial receive sequence number (IRS) is + learned during the connection establishing procedure. + + For a connection to be established or initialized, the two TCPs must + synchronize on each other's initial sequence numbers. This is done in + an exchange of connection establishing segments carrying a control bit + called "SYN" (for synchronize) and the initial sequence numbers. As a + shorthand, segments carrying the SYN bit are also called "SYNs". + Hence, the solution requires a suitable mechanism for picking an + initial sequence number and a slightly involved handshake to exchange + the ISN's. + + The synchronization requires each side to send it's own initial + sequence number and to receive a confirmation of it in acknowledgment + from the other side. Each side must also receive the other side's + initial sequence number and send a confirming acknowledgment. + + 1) A --> B SYN my sequence number is X + 2) A <-- B ACK your sequence number is X + 3) A <-- B SYN my sequence number is Y + 4) A --> B ACK your sequence number is Y + + + + [Page 27] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + Because steps 2 and 3 can be combined in a single message this is + called the three way (or three message) handshake. + + A three way handshake is necessary because sequence numbers are not + tied to a global clock in the network, and TCPs may have different + mechanisms for picking the ISN's. The receiver of the first SYN has + no way of knowing whether the segment was an old delayed one or not, + unless it remembers the last sequence number used on the connection + (which is not always possible), and so it must ask the sender to + verify this SYN. The three way handshake and the advantages of a + clock-driven scheme are discussed in [3]. + + Knowing When to Keep Quiet + + To be sure that a TCP does not create a segment that carries a + sequence number which may be duplicated by an old segment remaining in + the network, the TCP must keep quiet for a maximum segment lifetime + (MSL) before assigning any sequence numbers upon starting up or + recovering from a crash in which memory of sequence numbers in use was + lost. For this specification the MSL is taken to be 2 minutes. This + is an engineering choice, and may be changed if experience indicates + it is desirable to do so. Note that if a TCP is reinitialized in some + sense, yet retains its memory of sequence numbers in use, then it need + not wait at all; it must only be sure to use sequence numbers larger + than those recently used. + + The TCP Quiet Time Concept + + This specification provides that hosts which "crash" without + retaining any knowledge of the last sequence numbers transmitted on + each active (i.e., not closed) connection shall delay emitting any + TCP segments for at least the agreed Maximum Segment Lifetime (MSL) + in the internet system of which the host is a part. In the + paragraphs below, an explanation for this specification is given. + TCP implementors may violate the "quiet time" restriction, but only + at the risk of causing some old data to be accepted as new or new + data rejected as old duplicated by some receivers in the internet + system. + + TCPs consume sequence number space each time a segment is formed and + entered into the network output queue at a source host. The + duplicate detection and sequencing algorithm in the TCP protocol + relies on the unique binding of segment data to sequence space to + the extent that sequence numbers will not cycle through all 2**32 + values before the segment data bound to those sequence numbers has + been delivered and acknowledged by the receiver and all duplicate + copies of the segments have "drained" from the internet. Without + such an assumption, two distinct TCP segments could conceivably be + + +[Page 28] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + assigned the same or overlapping sequence numbers, causing confusion + at the receiver as to which data is new and which is old. Remember + that each segment is bound to as many consecutive sequence numbers + as there are octets of data in the segment. + + Under normal conditions, TCPs keep track of the next sequence number + to emit and the oldest awaiting acknowledgment so as to avoid + mistakenly using a sequence number over before its first use has + been acknowledged. This alone does not guarantee that old duplicate + data is drained from the net, so the sequence space has been made + very large to reduce the probability that a wandering duplicate will + cause trouble upon arrival. At 2 megabits/sec. it takes 4.5 hours + to use up 2**32 octets of sequence space. Since the maximum segment + lifetime in the net is not likely to exceed a few tens of seconds, + this is deemed ample protection for foreseeable nets, even if data + rates escalate to l0's of megabits/sec. At 100 megabits/sec, the + cycle time is 5.4 minutes which may be a little short, but still + within reason. + + The basic duplicate detection and sequencing algorithm in TCP can be + defeated, however, if a source TCP does not have any memory of the + sequence numbers it last used on a given connection. For example, if + the TCP were to start all connections with sequence number 0, then + upon crashing and restarting, a TCP might re-form an earlier + connection (possibly after half-open connection resolution) and emit + packets with sequence numbers identical to or overlapping with + packets still in the network which were emitted on an earlier + incarnation of the same connection. In the absence of knowledge + about the sequence numbers used on a particular connection, the TCP + specification recommends that the source delay for MSL seconds + before emitting segments on the connection, to allow time for + segments from the earlier connection incarnation to drain from the + system. + + Even hosts which can remember the time of day and used it to select + initial sequence number values are not immune from this problem + (i.e., even if time of day is used to select an initial sequence + number for each new connection incarnation). + + Suppose, for example, that a connection is opened starting with + sequence number S. Suppose that this connection is not used much + and that eventually the initial sequence number function (ISN(t)) + takes on a value equal to the sequence number, say S1, of the last + segment sent by this TCP on a particular connection. Now suppose, + at this instant, the host crashes, recovers, and establishes a new + incarnation of the connection. The initial sequence number chosen is + S1 = ISN(t) -- last used sequence number on old incarnation of + connection!! If the recovery occurs quickly enough, any old + + + [Page 29] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + duplicates in the net bearing sequence numbers in the neighborhood + of S1 may arrive and be treated as new packets by the receiver of + the new incarnation of the connection. + + The problem is that the recovering host may not know for how long it + crashed nor does it know whether there are still old duplicates in + the system from earlier connection incarnations. + + One way to deal with this problem is to deliberately delay emitting + segments for one MSL after recovery from a crash- this is the "quite + time" specification. Hosts which prefer to avoid waiting are + willing to risk possible confusion of old and new packets at a given + destination may choose not to wait for the "quite time". + Implementors may provide TCP users with the ability to select on a + connection by connection basis whether to wait after a crash, or may + informally implement the "quite time" for all connections. + Obviously, even where a user selects to "wait," this is not + necessary after the host has been "up" for at least MSL seconds. + + To summarize: every segment emitted occupies one or more sequence + numbers in the sequence space, the numbers occupied by a segment are + "busy" or "in use" until MSL seconds have passed, upon crashing a + block of space-time is occupied by the octets of the last emitted + segment, if a new connection is started too soon and uses any of the + sequence numbers in the space-time footprint of the last segment of + the previous connection incarnation, there is a potential sequence + number overlap area which could cause confusion at the receiver. + +3.4. Establishing a connection + + The "three-way handshake" is the procedure used to establish a + connection. This procedure normally is initiated by one TCP and + responded to by another TCP. The procedure also works if two TCP + simultaneously initiate the procedure. When simultaneous attempt + occurs, each TCP receives a "SYN" segment which carries no + acknowledgment after it has sent a "SYN". Of course, the arrival of + an old duplicate "SYN" segment can potentially make it appear, to the + recipient, that a simultaneous connection initiation is in progress. + Proper use of "reset" segments can disambiguate these cases. + + Several examples of connection initiation follow. Although these + examples do not show connection synchronization using data-carrying + segments, this is perfectly legitimate, so long as the receiving TCP + doesn't deliver the data to the user until it is clear the data is + valid (i.e., the data must be buffered at the receiver until the + connection reaches the ESTABLISHED state). The three-way handshake + reduces the possibility of false connections. It is the + + + +[Page 30] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + implementation of a trade-off between memory and messages to provide + information for this checking. + + The simplest three-way handshake is shown in figure 7 below. The + figures should be interpreted in the following way. Each line is + numbered for reference purposes. Right arrows (-->) indicate + departure of a TCP segment from TCP A to TCP B, or arrival of a + segment at B from A. Left arrows (<--), indicate the reverse. + Ellipsis (...) indicates a segment which is still in the network + (delayed). An "XXX" indicates a segment which is lost or rejected. + Comments appear in parentheses. TCP states represent the state AFTER + the departure or arrival of the segment (whose contents are shown in + the center of each line). Segment contents are shown in abbreviated + form, with sequence number, control flags, and ACK field. Other + fields such as window, addresses, lengths, and text have been left out + in the interest of clarity. + + + + TCP A TCP B + + 1. CLOSED LISTEN + + 2. SYN-SENT --> --> SYN-RECEIVED + + 3. ESTABLISHED <-- <-- SYN-RECEIVED + + 4. ESTABLISHED --> --> ESTABLISHED + + 5. ESTABLISHED --> --> ESTABLISHED + + Basic 3-Way Handshake for Connection Synchronization + + Figure 7. + + In line 2 of figure 7, TCP A begins by sending a SYN segment + indicating that it will use sequence numbers starting with sequence + number 100. In line 3, TCP B sends a SYN and acknowledges the SYN it + received from TCP A. Note that the acknowledgment field indicates TCP + B is now expecting to hear sequence 101, acknowledging the SYN which + occupied sequence 100. + + At line 4, TCP A responds with an empty segment containing an ACK for + TCP B's SYN; and in line 5, TCP A sends some data. Note that the + sequence number of the segment in line 5 is the same as in line 4 + because the ACK does not occupy sequence number space (if it did, we + would wind up ACKing ACK's!!). + + + + [Page 31] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + Simultaneous initiation is only slightly more complex, as is shown in + figure 8. Each TCP cycles from CLOSED to SYN-SENT to SYN-RECEIVED to + ESTABLISHED. + + + + TCP A TCP B + + 1. CLOSED CLOSED + + 2. SYN-SENT --> ... + + 3. SYN-RECEIVED <-- <-- SYN-SENT + + 4. ... --> SYN-RECEIVED + + 5. SYN-RECEIVED --> ... + + 6. ESTABLISHED <-- <-- SYN-RECEIVED + + 7. ... --> ESTABLISHED + + Simultaneous Connection Synchronization + + Figure 8. + + The principle reason for the three-way handshake is to prevent old + duplicate connection initiations from causing confusion. To deal with + this, a special control message, reset, has been devised. If the + receiving TCP is in a non-synchronized state (i.e., SYN-SENT, + SYN-RECEIVED), it returns to LISTEN on receiving an acceptable reset. + If the TCP is in one of the synchronized states (ESTABLISHED, + FIN-WAIT-1, FIN-WAIT-2, CLOSE-WAIT, CLOSING, LAST-ACK, TIME-WAIT), it + aborts the connection and informs its user. We discuss this latter + case under "half-open" connections below. + + + + + + + + + + + + + + + +[Page 32] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + + + TCP A TCP B + + 1. CLOSED LISTEN + + 2. SYN-SENT --> ... + + 3. (duplicate) ... --> SYN-RECEIVED + + 4. SYN-SENT <-- <-- SYN-RECEIVED + + 5. SYN-SENT --> --> LISTEN + + + 6. ... --> SYN-RECEIVED + + 7. SYN-SENT <-- <-- SYN-RECEIVED + + 8. ESTABLISHED --> --> ESTABLISHED + + Recovery from Old Duplicate SYN + + Figure 9. + + As a simple example of recovery from old duplicates, consider + figure 9. At line 3, an old duplicate SYN arrives at TCP B. TCP B + cannot tell that this is an old duplicate, so it responds normally + (line 4). TCP A detects that the ACK field is incorrect and returns a + RST (reset) with its SEQ field selected to make the segment + believable. TCP B, on receiving the RST, returns to the LISTEN state. + When the original SYN (pun intended) finally arrives at line 6, the + synchronization proceeds normally. If the SYN at line 6 had arrived + before the RST, a more complex exchange might have occurred with RST's + sent in both directions. + + Half-Open Connections and Other Anomalies + + An established connection is said to be "half-open" if one of the + TCPs has closed or aborted the connection at its end without the + knowledge of the other, or if the two ends of the connection have + become desynchronized owing to a crash that resulted in loss of + memory. Such connections will automatically become reset if an + attempt is made to send data in either direction. However, half-open + connections are expected to be unusual, and the recovery procedure is + mildly involved. + + If at site A the connection no longer exists, then an attempt by the + + + [Page 33] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + user at site B to send any data on it will result in the site B TCP + receiving a reset control message. Such a message indicates to the + site B TCP that something is wrong, and it is expected to abort the + connection. + + Assume that two user processes A and B are communicating with one + another when a crash occurs causing loss of memory to A's TCP. + Depending on the operating system supporting A's TCP, it is likely + that some error recovery mechanism exists. When the TCP is up again, + A is likely to start again from the beginning or from a recovery + point. As a result, A will probably try to OPEN the connection again + or try to SEND on the connection it believes open. In the latter + case, it receives the error message "connection not open" from the + local (A's) TCP. In an attempt to establish the connection, A's TCP + will send a segment containing SYN. This scenario leads to the + example shown in figure 10. After TCP A crashes, the user attempts to + re-open the connection. TCP B, in the meantime, thinks the connection + is open. + + + + TCP A TCP B + + 1. (CRASH) (send 300,receive 100) + + 2. CLOSED ESTABLISHED + + 3. SYN-SENT --> --> (??) + + 4. (!!!!) <-- <-- ESTABLISHED + + 5. SYN-SENT --> --> (Abort!!!!) + + 6. SYN-SENT CLOSED + + 7. SYN-SENT --> --> + + Half-Open Connection Discovery + + Figure 10. + + When the SYN arrives at line 3, TCP B, being in a synchronized state, + and the incoming segment outside the window, responds with an + acknowledgment indicating what sequence it next expects to hear (ACK + 100). TCP A sees that this segment does not acknowledge anything it + sent and, being unsynchronized, sends a reset (RST) because it has + detected a half-open connection. TCP B aborts at line 5. TCP A will + + + +[Page 34] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + continue to try to establish the connection; the problem is now + reduced to the basic 3-way handshake of figure 7. + + An interesting alternative case occurs when TCP A crashes and TCP B + tries to send data on what it thinks is a synchronized connection. + This is illustrated in figure 11. In this case, the data arriving at + TCP A from TCP B (line 2) is unacceptable because no such connection + exists, so TCP A sends a RST. The RST is acceptable so TCP B + processes it and aborts the connection. + + + + TCP A TCP B + + 1. (CRASH) (send 300,receive 100) + + 2. (??) <-- <-- ESTABLISHED + + 3. --> --> (ABORT!!!!) + + Active Side Causes Half-Open Connection Discovery + + Figure 11. + + In figure 12, we find the two TCPs A and B with passive connections + waiting for SYN. An old duplicate arriving at TCP B (line 2) stirs B + into action. A SYN-ACK is returned (line 3) and causes TCP A to + generate a RST (the ACK in line 3 is not acceptable). TCP B accepts + the reset and returns to its passive LISTEN state. + + + + TCP A TCP B + + 1. LISTEN LISTEN + + 2. ... --> SYN-RECEIVED + + 3. (??) <-- <-- SYN-RECEIVED + + 4. --> --> (return to LISTEN!!) + + 5. LISTEN LISTEN + + Old Duplicate SYN Initiates a Reset on two Passive Sockets + + Figure 12. + + + + [Page 35] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + A variety of other cases are possible, all of which are accounted for + by the following rules for RST generation and processing. + + Reset Generation + + As a general rule, reset (RST) must be sent whenever a segment arrives + which apparently is not intended for the current connection. A reset + must not be sent if it is not clear that this is the case. + + There are three groups of states: + + 1. If the connection does not exist (CLOSED) then a reset is sent + in response to any incoming segment except another reset. In + particular, SYNs addressed to a non-existent connection are rejected + by this means. + + If the incoming segment has an ACK field, the reset takes its + sequence number from the ACK field of the segment, otherwise the + reset has sequence number zero and the ACK field is set to the sum + of the sequence number and segment length of the incoming segment. + The connection remains in the CLOSED state. + + 2. If the connection is in any non-synchronized state (LISTEN, + SYN-SENT, SYN-RECEIVED), and the incoming segment acknowledges + something not yet sent (the segment carries an unacceptable ACK), or + if an incoming segment has a security level or compartment which + does not exactly match the level and compartment requested for the + connection, a reset is sent. + + If our SYN has not been acknowledged and the precedence level of the + incoming segment is higher than the precedence level requested then + either raise the local precedence level (if allowed by the user and + the system) or send a reset; or if the precedence level of the + incoming segment is lower than the precedence level requested then + continue as if the precedence matched exactly (if the remote TCP + cannot raise the precedence level to match ours this will be + detected in the next segment it sends, and the connection will be + terminated then). If our SYN has been acknowledged (perhaps in this + incoming segment) the precedence level of the incoming segment must + match the local precedence level exactly, if it does not a reset + must be sent. + + If the incoming segment has an ACK field, the reset takes its + sequence number from the ACK field of the segment, otherwise the + reset has sequence number zero and the ACK field is set to the sum + of the sequence number and segment length of the incoming segment. + The connection remains in the same state. + + + +[Page 36] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + 3. If the connection is in a synchronized state (ESTABLISHED, + FIN-WAIT-1, FIN-WAIT-2, CLOSE-WAIT, CLOSING, LAST-ACK, TIME-WAIT), + any unacceptable segment (out of window sequence number or + unacceptible acknowledgment number) must elicit only an empty + acknowledgment segment containing the current send-sequence number + and an acknowledgment indicating the next sequence number expected + to be received, and the connection remains in the same state. + + If an incoming segment has a security level, or compartment, or + precedence which does not exactly match the level, and compartment, + and precedence requested for the connection,a reset is sent and + connection goes to the CLOSED state. The reset takes its sequence + number from the ACK field of the incoming segment. + + Reset Processing + + In all states except SYN-SENT, all reset (RST) segments are validated + by checking their SEQ-fields. A reset is valid if its sequence number + is in the window. In the SYN-SENT state (a RST received in response + to an initial SYN), the RST is acceptable if the ACK field + acknowledges the SYN. + + The receiver of a RST first validates it, then changes state. If the + receiver was in the LISTEN state, it ignores it. If the receiver was + in SYN-RECEIVED state and had previously been in the LISTEN state, + then the receiver returns to the LISTEN state, otherwise the receiver + aborts the connection and goes to the CLOSED state. If the receiver + was in any other state, it aborts the connection and advises the user + and goes to the CLOSED state. + +3.5. Closing a Connection + + CLOSE is an operation meaning "I have no more data to send." The + notion of closing a full-duplex connection is subject to ambiguous + interpretation, of course, since it may not be obvious how to treat + the receiving side of the connection. We have chosen to treat CLOSE + in a simplex fashion. The user who CLOSEs may continue to RECEIVE + until he is told that the other side has CLOSED also. Thus, a program + could initiate several SENDs followed by a CLOSE, and then continue to + RECEIVE until signaled that a RECEIVE failed because the other side + has CLOSED. We assume that the TCP will signal a user, even if no + RECEIVEs are outstanding, that the other side has closed, so the user + can terminate his side gracefully. A TCP will reliably deliver all + buffers SENT before the connection was CLOSED so a user who expects no + data in return need only wait to hear the connection was CLOSED + successfully to know that all his data was received at the destination + TCP. Users must keep reading connections they close for sending until + the TCP says no more data. + + + [Page 37] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + There are essentially three cases: + + 1) The user initiates by telling the TCP to CLOSE the connection + + 2) The remote TCP initiates by sending a FIN control signal + + 3) Both users CLOSE simultaneously + + Case 1: Local user initiates the close + + In this case, a FIN segment can be constructed and placed on the + outgoing segment queue. No further SENDs from the user will be + accepted by the TCP, and it enters the FIN-WAIT-1 state. RECEIVEs + are allowed in this state. All segments preceding and including FIN + will be retransmitted until acknowledged. When the other TCP has + both acknowledged the FIN and sent a FIN of its own, the first TCP + can ACK this FIN. Note that a TCP receiving a FIN will ACK but not + send its own FIN until its user has CLOSED the connection also. + + Case 2: TCP receives a FIN from the network + + If an unsolicited FIN arrives from the network, the receiving TCP + can ACK it and tell the user that the connection is closing. The + user will respond with a CLOSE, upon which the TCP can send a FIN to + the other TCP after sending any remaining data. The TCP then waits + until its own FIN is acknowledged whereupon it deletes the + connection. If an ACK is not forthcoming, after the user timeout + the connection is aborted and the user is told. + + Case 3: both users close simultaneously + + A simultaneous CLOSE by users at both ends of a connection causes + FIN segments to be exchanged. When all segments preceding the FINs + have been processed and acknowledged, each TCP can ACK the FIN it + has received. Both will, upon receiving these ACKs, delete the + connection. + + + + + + + + + + + + + + +[Page 38] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + + + TCP A TCP B + + 1. ESTABLISHED ESTABLISHED + + 2. (Close) + FIN-WAIT-1 --> --> CLOSE-WAIT + + 3. FIN-WAIT-2 <-- <-- CLOSE-WAIT + + 4. (Close) + TIME-WAIT <-- <-- LAST-ACK + + 5. TIME-WAIT --> --> CLOSED + + 6. (2 MSL) + CLOSED + + Normal Close Sequence + + Figure 13. + + + + TCP A TCP B + + 1. ESTABLISHED ESTABLISHED + + 2. (Close) (Close) + FIN-WAIT-1 --> ... FIN-WAIT-1 + <-- <-- + ... --> + + 3. CLOSING --> ... CLOSING + <-- <-- + ... --> + + 4. TIME-WAIT TIME-WAIT + (2 MSL) (2 MSL) + CLOSED CLOSED + + Simultaneous Close Sequence + + Figure 14. + + + + + + [Page 39] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + +3.6. Precedence and Security + + The intent is that connection be allowed only between ports operating + with exactly the same security and compartment values and at the + higher of the precedence level requested by the two ports. + + The precedence and security parameters used in TCP are exactly those + defined in the Internet Protocol (IP) [2]. Throughout this TCP + specification the term "security/compartment" is intended to indicate + the security parameters used in IP including security, compartment, + user group, and handling restriction. + + A connection attempt with mismatched security/compartment values or a + lower precedence value must be rejected by sending a reset. Rejecting + a connection due to too low a precedence only occurs after an + acknowledgment of the SYN has been received. + + Note that TCP modules which operate only at the default value of + precedence will still have to check the precedence of incoming + segments and possibly raise the precedence level they use on the + connection. + + The security paramaters may be used even in a non-secure environment + (the values would indicate unclassified data), thus hosts in + non-secure environments must be prepared to receive the security + parameters, though they need not send them. + +3.7. Data Communication + + Once the connection is established data is communicated by the + exchange of segments. Because segments may be lost due to errors + (checksum test failure), or network congestion, TCP uses + retransmission (after a timeout) to ensure delivery of every segment. + Duplicate segments may arrive due to network or TCP retransmission. + As discussed in the section on sequence numbers the TCP performs + certain tests on the sequence and acknowledgment numbers in the + segments to verify their acceptability. + + The sender of data keeps track of the next sequence number to use in + the variable SND.NXT. The receiver of data keeps track of the next + sequence number to expect in the variable RCV.NXT. The sender of data + keeps track of the oldest unacknowledged sequence number in the + variable SND.UNA. If the data flow is momentarily idle and all data + sent has been acknowledged then the three variables will be equal. + + When the sender creates a segment and transmits it the sender advances + SND.NXT. When the receiver accepts a segment it advances RCV.NXT and + sends an acknowledgment. When the data sender receives an + + +[Page 40] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + acknowledgment it advances SND.UNA. The extent to which the values of + these variables differ is a measure of the delay in the communication. + The amount by which the variables are advanced is the length of the + data in the segment. Note that once in the ESTABLISHED state all + segments must carry current acknowledgment information. + + The CLOSE user call implies a push function, as does the FIN control + flag in an incoming segment. + + Retransmission Timeout + + Because of the variability of the networks that compose an + internetwork system and the wide range of uses of TCP connections the + retransmission timeout must be dynamically determined. One procedure + for determining a retransmission time out is given here as an + illustration. + + An Example Retransmission Timeout Procedure + + Measure the elapsed time between sending a data octet with a + particular sequence number and receiving an acknowledgment that + covers that sequence number (segments sent do not have to match + segments received). This measured elapsed time is the Round Trip + Time (RTT). Next compute a Smoothed Round Trip Time (SRTT) as: + + SRTT = ( ALPHA * SRTT ) + ((1-ALPHA) * RTT) + + and based on this, compute the retransmission timeout (RTO) as: + + RTO = min[UBOUND,max[LBOUND,(BETA*SRTT)]] + + where UBOUND is an upper bound on the timeout (e.g., 1 minute), + LBOUND is a lower bound on the timeout (e.g., 1 second), ALPHA is + a smoothing factor (e.g., .8 to .9), and BETA is a delay variance + factor (e.g., 1.3 to 2.0). + + The Communication of Urgent Information + + The objective of the TCP urgent mechanism is to allow the sending user + to stimulate the receiving user to accept some urgent data and to + permit the receiving TCP to indicate to the receiving user when all + the currently known urgent data has been received by the user. + + This mechanism permits a point in the data stream to be designated as + the end of urgent information. Whenever this point is in advance of + the receive sequence number (RCV.NXT) at the receiving TCP, that TCP + must tell the user to go into "urgent mode"; when the receive sequence + number catches up to the urgent pointer, the TCP must tell user to go + + + [Page 41] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + into "normal mode". If the urgent pointer is updated while the user + is in "urgent mode", the update will be invisible to the user. + + The method employs a urgent field which is carried in all segments + transmitted. The URG control flag indicates that the urgent field is + meaningful and must be added to the segment sequence number to yield + the urgent pointer. The absence of this flag indicates that there is + no urgent data outstanding. + + To send an urgent indication the user must also send at least one data + octet. If the sending user also indicates a push, timely delivery of + the urgent information to the destination process is enhanced. + + Managing the Window + + The window sent in each segment indicates the range of sequence + numbers the sender of the window (the data receiver) is currently + prepared to accept. There is an assumption that this is related to + the currently available data buffer space available for this + connection. + + Indicating a large window encourages transmissions. If more data + arrives than can be accepted, it will be discarded. This will result + in excessive retransmissions, adding unnecessarily to the load on the + network and the TCPs. Indicating a small window may restrict the + transmission of data to the point of introducing a round trip delay + between each new segment transmitted. + + The mechanisms provided allow a TCP to advertise a large window and to + subsequently advertise a much smaller window without having accepted + that much data. This, so called "shrinking the window," is strongly + discouraged. The robustness principle dictates that TCPs will not + shrink the window themselves, but will be prepared for such behavior + on the part of other TCPs. + + The sending TCP must be prepared to accept from the user and send at + least one octet of new data even if the send window is zero. The + sending TCP must regularly retransmit to the receiving TCP even when + the window is zero. Two minutes is recommended for the retransmission + interval when the window is zero. This retransmission is essential to + guarantee that when either TCP has a zero window the re-opening of the + window will be reliably reported to the other. + + When the receiving TCP has a zero window and a segment arrives it must + still send an acknowledgment showing its next expected sequence number + and current window (zero). + + The sending TCP packages the data to be transmitted into segments + + +[Page 42] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + which fit the current window, and may repackage segments on the + retransmission queue. Such repackaging is not required, but may be + helpful. + + In a connection with a one-way data flow, the window information will + be carried in acknowledgment segments that all have the same sequence + number so there will be no way to reorder them if they arrive out of + order. This is not a serious problem, but it will allow the window + information to be on occasion temporarily based on old reports from + the data receiver. A refinement to avoid this problem is to act on + the window information from segments that carry the highest + acknowledgment number (that is segments with acknowledgment number + equal or greater than the highest previously received). + + The window management procedure has significant influence on the + communication performance. The following comments are suggestions to + implementers. + + Window Management Suggestions + + Allocating a very small window causes data to be transmitted in + many small segments when better performance is achieved using + fewer large segments. + + One suggestion for avoiding small windows is for the receiver to + defer updating a window until the additional allocation is at + least X percent of the maximum allocation possible for the + connection (where X might be 20 to 40). + + Another suggestion is for the sender to avoid sending small + segments by waiting until the window is large enough before + sending data. If the the user signals a push function then the + data must be sent even if it is a small segment. + + Note that the acknowledgments should not be delayed or unnecessary + retransmissions will result. One strategy would be to send an + acknowledgment when a small segment arrives (with out updating the + window information), and then to send another acknowledgment with + new window information when the window is larger. + + The segment sent to probe a zero window may also begin a break up + of transmitted data into smaller and smaller segments. If a + segment containing a single data octet sent to probe a zero window + is accepted, it consumes one octet of the window now available. + If the sending TCP simply sends as much as it can whenever the + window is non zero, the transmitted data will be broken into + alternating big and small segments. As time goes on, occasional + pauses in the receiver making window allocation available will + + + [Page 43] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + result in breaking the big segments into a small and not quite so + big pair. And after a while the data transmission will be in + mostly small segments. + + The suggestion here is that the TCP implementations need to + actively attempt to combine small window allocations into larger + windows, since the mechanisms for managing the window tend to lead + to many small windows in the simplest minded implementations. + +3.8. Interfaces + + There are of course two interfaces of concern: the user/TCP interface + and the TCP/lower-level interface. We have a fairly elaborate model + of the user/TCP interface, but the interface to the lower level + protocol module is left unspecified here, since it will be specified + in detail by the specification of the lowel level protocol. For the + case that the lower level is IP we note some of the parameter values + that TCPs might use. + + User/TCP Interface + + The following functional description of user commands to the TCP is, + at best, fictional, since every operating system will have different + facilities. Consequently, we must warn readers that different TCP + implementations may have different user interfaces. However, all + TCPs must provide a certain minimum set of services to guarantee + that all TCP implementations can support the same protocol + hierarchy. This section specifies the functional interfaces + required of all TCP implementations. + + TCP User Commands + + The following sections functionally characterize a USER/TCP + interface. The notation used is similar to most procedure or + function calls in high level languages, but this usage is not + meant to rule out trap type service calls (e.g., SVCs, UUOs, + EMTs). + + The user commands described below specify the basic functions the + TCP must perform to support interprocess communication. + Individual implementations must define their own exact format, and + may provide combinations or subsets of the basic functions in + single calls. In particular, some implementations may wish to + automatically OPEN a connection on the first SEND or RECEIVE + issued by the user for a given connection. + + + + + +[Page 44] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + In providing interprocess communication facilities, the TCP must + not only accept commands, but must also return information to the + processes it serves. The latter consists of: + + (a) general information about a connection (e.g., interrupts, + remote close, binding of unspecified foreign socket). + + (b) replies to specific user commands indicating success or + various types of failure. + + Open + + Format: OPEN (local port, foreign socket, active/passive + [, timeout] [, precedence] [, security/compartment] [, options]) + -> local connection name + + We assume that the local TCP is aware of the identity of the + processes it serves and will check the authority of the process + to use the connection specified. Depending upon the + implementation of the TCP, the local network and TCP identifiers + for the source address will either be supplied by the TCP or the + lower level protocol (e.g., IP). These considerations are the + result of concern about security, to the extent that no TCP be + able to masquerade as another one, and so on. Similarly, no + process can masquerade as another without the collusion of the + TCP. + + If the active/passive flag is set to passive, then this is a + call to LISTEN for an incoming connection. A passive open may + have either a fully specified foreign socket to wait for a + particular connection or an unspecified foreign socket to wait + for any call. A fully specified passive call can be made active + by the subsequent execution of a SEND. + + A transmission control block (TCB) is created and partially + filled in with data from the OPEN command parameters. + + On an active OPEN command, the TCP will begin the procedure to + synchronize (i.e., establish) the connection at once. + + The timeout, if present, permits the caller to set up a timeout + for all data submitted to TCP. If data is not successfully + delivered to the destination within the timeout period, the TCP + will abort the connection. The present global default is five + minutes. + + The TCP or some component of the operating system will verify + the users authority to open a connection with the specified + + + [Page 45] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + precedence or security/compartment. The absence of precedence + or security/compartment specification in the OPEN call indicates + the default values must be used. + + TCP will accept incoming requests as matching only if the + security/compartment information is exactly the same and only if + the precedence is equal to or higher than the precedence + requested in the OPEN call. + + The precedence for the connection is the higher of the values + requested in the OPEN call and received from the incoming + request, and fixed at that value for the life of the + connection.Implementers may want to give the user control of + this precedence negotiation. For example, the user might be + allowed to specify that the precedence must be exactly matched, + or that any attempt to raise the precedence be confirmed by the + user. + + A local connection name will be returned to the user by the TCP. + The local connection name can then be used as a short hand term + for the connection defined by the + pair. + + Send + + Format: SEND (local connection name, buffer address, byte + count, PUSH flag, URGENT flag [,timeout]) + + This call causes the data contained in the indicated user buffer + to be sent on the indicated connection. If the connection has + not been opened, the SEND is considered an error. Some + implementations may allow users to SEND first; in which case, an + automatic OPEN would be done. If the calling process is not + authorized to use this connection, an error is returned. + + If the PUSH flag is set, the data must be transmitted promptly + to the receiver, and the PUSH bit will be set in the last TCP + segment created from the buffer. If the PUSH flag is not set, + the data may be combined with data from subsequent SENDs for + transmission efficiency. + + If the URGENT flag is set, segments sent to the destination TCP + will have the urgent pointer set. The receiving TCP will signal + the urgent condition to the receiving process if the urgent + pointer indicates that data preceding the urgent pointer has not + been consumed by the receiving process. The purpose of urgent + is to stimulate the receiver to process the urgent data and to + indicate to the receiver when all the currently known urgent + + +[Page 46] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + data has been received. The number of times the sending user's + TCP signals urgent will not necessarily be equal to the number + of times the receiving user will be notified of the presence of + urgent data. + + If no foreign socket was specified in the OPEN, but the + connection is established (e.g., because a LISTENing connection + has become specific due to a foreign segment arriving for the + local socket), then the designated buffer is sent to the implied + foreign socket. Users who make use of OPEN with an unspecified + foreign socket can make use of SEND without ever explicitly + knowing the foreign socket address. + + However, if a SEND is attempted before the foreign socket + becomes specified, an error will be returned. Users can use the + STATUS call to determine the status of the connection. In some + implementations the TCP may notify the user when an unspecified + socket is bound. + + If a timeout is specified, the current user timeout for this + connection is changed to the new one. + + In the simplest implementation, SEND would not return control to + the sending process until either the transmission was complete + or the timeout had been exceeded. However, this simple method + is both subject to deadlocks (for example, both sides of the + connection might try to do SENDs before doing any RECEIVEs) and + offers poor performance, so it is not recommended. A more + sophisticated implementation would return immediately to allow + the process to run concurrently with network I/O, and, + furthermore, to allow multiple SENDs to be in progress. + Multiple SENDs are served in first come, first served order, so + the TCP will queue those it cannot service immediately. + + We have implicitly assumed an asynchronous user interface in + which a SEND later elicits some kind of SIGNAL or + pseudo-interrupt from the serving TCP. An alternative is to + return a response immediately. For instance, SENDs might return + immediate local acknowledgment, even if the segment sent had not + been acknowledged by the distant TCP. We could optimistically + assume eventual success. If we are wrong, the connection will + close anyway due to the timeout. In implementations of this + kind (synchronous), there will still be some asynchronous + signals, but these will deal with the connection itself, and not + with specific segments or buffers. + + In order for the process to distinguish among error or success + indications for different SENDs, it might be appropriate for the + + + [Page 47] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + buffer address to be returned along with the coded response to + the SEND request. TCP-to-user signals are discussed below, + indicating the information which should be returned to the + calling process. + + Receive + + Format: RECEIVE (local connection name, buffer address, byte + count) -> byte count, urgent flag, push flag + + This command allocates a receiving buffer associated with the + specified connection. If no OPEN precedes this command or the + calling process is not authorized to use this connection, an + error is returned. + + In the simplest implementation, control would not return to the + calling program until either the buffer was filled, or some + error occurred, but this scheme is highly subject to deadlocks. + A more sophisticated implementation would permit several + RECEIVEs to be outstanding at once. These would be filled as + segments arrive. This strategy permits increased throughput at + the cost of a more elaborate scheme (possibly asynchronous) to + notify the calling program that a PUSH has been seen or a buffer + filled. + + If enough data arrive to fill the buffer before a PUSH is seen, + the PUSH flag will not be set in the response to the RECEIVE. + The buffer will be filled with as much data as it can hold. If + a PUSH is seen before the buffer is filled the buffer will be + returned partially filled and PUSH indicated. + + If there is urgent data the user will have been informed as soon + as it arrived via a TCP-to-user signal. The receiving user + should thus be in "urgent mode". If the URGENT flag is on, + additional urgent data remains. If the URGENT flag is off, this + call to RECEIVE has returned all the urgent data, and the user + may now leave "urgent mode". Note that data following the + urgent pointer (non-urgent data) cannot be delivered to the user + in the same buffer with preceeding urgent data unless the + boundary is clearly marked for the user. + + To distinguish among several outstanding RECEIVEs and to take + care of the case that a buffer is not completely filled, the + return code is accompanied by both a buffer pointer and a byte + count indicating the actual length of the data received. + + Alternative implementations of RECEIVE might have the TCP + + + +[Page 48] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + allocate buffer storage, or the TCP might share a ring buffer + with the user. + + Close + + Format: CLOSE (local connection name) + + This command causes the connection specified to be closed. If + the connection is not open or the calling process is not + authorized to use this connection, an error is returned. + Closing connections is intended to be a graceful operation in + the sense that outstanding SENDs will be transmitted (and + retransmitted), as flow control permits, until all have been + serviced. Thus, it should be acceptable to make several SEND + calls, followed by a CLOSE, and expect all the data to be sent + to the destination. It should also be clear that users should + continue to RECEIVE on CLOSING connections, since the other side + may be trying to transmit the last of its data. Thus, CLOSE + means "I have no more to send" but does not mean "I will not + receive any more." It may happen (if the user level protocol is + not well thought out) that the closing side is unable to get rid + of all its data before timing out. In this event, CLOSE turns + into ABORT, and the closing TCP gives up. + + The user may CLOSE the connection at any time on his own + initiative, or in response to various prompts from the TCP + (e.g., remote close executed, transmission timeout exceeded, + destination inaccessible). + + Because closing a connection requires communication with the + foreign TCP, connections may remain in the closing state for a + short time. Attempts to reopen the connection before the TCP + replies to the CLOSE command will result in error responses. + + Close also implies push function. + + Status + + Format: STATUS (local connection name) -> status data + + This is an implementation dependent user command and could be + excluded without adverse effect. Information returned would + typically come from the TCB associated with the connection. + + This command returns a data block containing the following + information: + + local socket, + + + [Page 49] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + + foreign socket, + local connection name, + receive window, + send window, + connection state, + number of buffers awaiting acknowledgment, + number of buffers pending receipt, + urgent state, + precedence, + security/compartment, + and transmission timeout. + + Depending on the state of the connection, or on the + implementation itself, some of this information may not be + available or meaningful. If the calling process is not + authorized to use this connection, an error is returned. This + prevents unauthorized processes from gaining information about a + connection. + + Abort + + Format: ABORT (local connection name) + + This command causes all pending SENDs and RECEIVES to be + aborted, the TCB to be removed, and a special RESET message to + be sent to the TCP on the other side of the connection. + Depending on the implementation, users may receive abort + indications for each outstanding SEND or RECEIVE, or may simply + receive an ABORT-acknowledgment. + + TCP-to-User Messages + + It is assumed that the operating system environment provides a + means for the TCP to asynchronously signal the user program. When + the TCP does signal a user program, certain information is passed + to the user. Often in the specification the information will be + an error message. In other cases there will be information + relating to the completion of processing a SEND or RECEIVE or + other user call. + + The following information is provided: + + Local Connection Name Always + Response String Always + Buffer Address Send & Receive + Byte count (counts bytes received) Receive + Push flag Receive + Urgent flag Receive + + +[Page 50] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + TCP/Lower-Level Interface + + The TCP calls on a lower level protocol module to actually send and + receive information over a network. One case is that of the ARPA + internetwork system where the lower level module is the Internet + Protocol (IP) [2]. + + If the lower level protocol is IP it provides arguments for a type + of service and for a time to live. TCP uses the following settings + for these parameters: + + Type of Service = Precedence: routine, Delay: normal, Throughput: + normal, Reliability: normal; or 00000000. + + Time to Live = one minute, or 00111100. + + Note that the assumed maximum segment lifetime is two minutes. + Here we explicitly ask that a segment be destroyed if it cannot + be delivered by the internet system within one minute. + + If the lower level is IP (or other protocol that provides this + feature) and source routing is used, the interface must allow the + route information to be communicated. This is especially important + so that the source and destination addresses used in the TCP + checksum be the originating source and ultimate destination. It is + also important to preserve the return route to answer connection + requests. + + Any lower level protocol will have to provide the source address, + destination address, and protocol fields, and some way to determine + the "TCP length", both to provide the functional equivlent service + of IP and to be used in the TCP checksum. + + + + + + + + + + + + + + + + + + + [Page 51] + + + September 1981 +Transmission Control Protocol +Functional Specification + + + +3.9. Event Processing + + The processing depicted in this section is an example of one possible + implementation. Other implementations may have slightly different + processing sequences, but they should differ from those in this + section only in detail, not in substance. + + The activity of the TCP can be characterized as responding to events. + The events that occur can be cast into three categories: user calls, + arriving segments, and timeouts. This section describes the + processing the TCP does in response to each of the events. In many + cases the processing required depends on the state of the connection. + + Events that occur: + + User Calls + + OPEN + SEND + RECEIVE + CLOSE + ABORT + STATUS + + Arriving Segments + + SEGMENT ARRIVES + + Timeouts + + USER TIMEOUT + RETRANSMISSION TIMEOUT + TIME-WAIT TIMEOUT + + The model of the TCP/user interface is that user commands receive an + immediate return and possibly a delayed response via an event or + pseudo interrupt. In the following descriptions, the term "signal" + means cause a delayed response. + + Error responses are given as character strings. For example, user + commands referencing connections that do not exist receive "error: + connection not open". + + Please note in the following that all arithmetic on sequence numbers, + acknowledgment numbers, windows, et cetera, is modulo 2**32 the size + of the sequence number space. Also note that "=<" means less than or + equal to (modulo 2**32). + + + +[Page 52] + + +September 1981 + Transmission Control Protocol + Functional Specification + + + + A natural way to think about processing incoming segments is to + imagine that they are first tested for proper sequence number (i.e., + that their contents lie in the range of the expected "receive window" + in the sequence number space) and then that they are generally queued + and processed in sequence number order. + + When a segment overlaps other already received segments we reconstruct + the segment to contain just the new data, and adjust the header fields + to be consistent. + + Note that if no state change is mentioned the TCP stays in the same + state. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + [Page 53] + + + September 1981 +Transmission Control Protocol +Functional Specification + OPEN Call + + + + OPEN Call + + CLOSED STATE (i.e., TCB does not exist) + + Create a new transmission control block (TCB) to hold connection + state information. Fill in local socket identifier, foreign + socket, precedence, security/compartment, and user timeout + information. Note that some parts of the foreign socket may be + unspecified in a passive OPEN and are to be filled in by the + parameters of the incoming SYN segment. Verify the security and + precedence requested are allowed for this user, if not return + "error: precedence not allowed" or "error: security/compartment + not allowed." If passive enter the LISTEN state and return. If + active and the foreign socket is unspecified, return "error: + foreign socket unspecified"; if active and the foreign socket is + specified, issue a SYN segment. An initial send sequence number + (ISS) is selected. A SYN segment of the form + is sent. Set SND.UNA to ISS, SND.NXT to ISS+1, enter SYN-SENT + state, and return. + + If the caller does not have access to the local socket specified, + return "error: connection illegal for this process". If there is + no room to create a new connection, return "error: insufficient + resources". + + LISTEN STATE + + If active and the foreign socket is specified, then change the + connection from passive to active, select an ISS. Send a SYN + segment, set SND.UNA to ISS, SND.NXT to ISS+1. Enter SYN-SENT + state. Data associated with SEND may be sent with SYN segment or + queued for transmission after entering ESTABLISHED state. The + urgent bit if requested in the command must be sent with the data + segments sent as a result of this command. If there is no room to + queue the request, respond with "error: insufficient resources". + If Foreign socket was not specified, then return "error: foreign + socket unspecified". + + + + + + + + + + + + +[Page 54] + + +September 1981 + Transmission Control Protocol + Functional Specification +OPEN Call + + + + SYN-SENT STATE + SYN-RECEIVED STATE + ESTABLISHED STATE + FIN-WAIT-1 STATE + FIN-WAIT-2 STATE + CLOSE-WAIT STATE + CLOSING STATE + LAST-ACK STATE + TIME-WAIT STATE + + Return "error: connection already exists". + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + [Page 55] + + + September 1981 +Transmission Control Protocol +Functional Specification + SEND Call + + + + SEND Call + + CLOSED STATE (i.e., TCB does not exist) + + If the user does not have access to such a connection, then return + "error: connection illegal for this process". + + Otherwise, return "error: connection does not exist". + + LISTEN STATE + + If the foreign socket is specified, then change the connection + from passive to active, select an ISS. Send a SYN segment, set + SND.UNA to ISS, SND.NXT to ISS+1. Enter SYN-SENT state. Data + associated with SEND may be sent with SYN segment or queued for + transmission after entering ESTABLISHED state. The urgent bit if + requested in the command must be sent with the data segments sent + as a result of this command. If there is no room to queue the + request, respond with "error: insufficient resources". If + Foreign socket was not specified, then return "error: foreign + socket unspecified". + + SYN-SENT STATE + SYN-RECEIVED STATE + + Queue the data for transmission after entering ESTABLISHED state. + If no space to queue, respond with "error: insufficient + resources". + + ESTABLISHED STATE + CLOSE-WAIT STATE + + Segmentize the buffer and send it with a piggybacked + acknowledgment (acknowledgment value = RCV.NXT). If there is + insufficient space to remember this buffer, simply return "error: + insufficient resources". + + If the urgent flag is set, then SND.UP <- SND.NXT-1 and set the + urgent pointer in the outgoing segments. + + + + + + + + + + +[Page 56] + + +September 1981 + Transmission Control Protocol + Functional Specification +SEND Call + + + + FIN-WAIT-1 STATE + FIN-WAIT-2 STATE + CLOSING STATE + LAST-ACK STATE + TIME-WAIT STATE + + Return "error: connection closing" and do not service request. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + [Page 57] + + + September 1981 +Transmission Control Protocol +Functional Specification + RECEIVE Call + + + + RECEIVE Call + + CLOSED STATE (i.e., TCB does not exist) + + If the user does not have access to such a connection, return + "error: connection illegal for this process". + + Otherwise return "error: connection does not exist". + + LISTEN STATE + SYN-SENT STATE + SYN-RECEIVED STATE + + Queue for processing after entering ESTABLISHED state. If there + is no room to queue this request, respond with "error: + insufficient resources". + + ESTABLISHED STATE + FIN-WAIT-1 STATE + FIN-WAIT-2 STATE + + If insufficient incoming segments are queued to satisfy the + request, queue the request. If there is no queue space to + remember the RECEIVE, respond with "error: insufficient + resources". + + Reassemble queued incoming segments into receive buffer and return + to user. Mark "push seen" (PUSH) if this is the case. + + If RCV.UP is in advance of the data currently being passed to the + user notify the user of the presence of urgent data. + + When the TCP takes responsibility for delivering data to the user + that fact must be communicated to the sender via an + acknowledgment. The formation of such an acknowledgment is + described below in the discussion of processing an incoming + segment. + + + + + + + + + + + + +[Page 58] + + +September 1981 + Transmission Control Protocol + Functional Specification +RECEIVE Call + + + + CLOSE-WAIT STATE + + Since the remote side has already sent FIN, RECEIVEs must be + satisfied by text already on hand, but not yet delivered to the + user. If no text is awaiting delivery, the RECEIVE will get a + "error: connection closing" response. Otherwise, any remaining + text can be used to satisfy the RECEIVE. + + CLOSING STATE + LAST-ACK STATE + TIME-WAIT STATE + + Return "error: connection closing". + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + [Page 59] + + + September 1981 +Transmission Control Protocol +Functional Specification + CLOSE Call + + + + CLOSE Call + + CLOSED STATE (i.e., TCB does not exist) + + If the user does not have access to such a connection, return + "error: connection illegal for this process". + + Otherwise, return "error: connection does not exist". + + LISTEN STATE + + Any outstanding RECEIVEs are returned with "error: closing" + responses. Delete TCB, enter CLOSED state, and return. + + SYN-SENT STATE + + Delete the TCB and return "error: closing" responses to any + queued SENDs, or RECEIVEs. + + SYN-RECEIVED STATE + + If no SENDs have been issued and there is no pending data to send, + then form a FIN segment and send it, and enter FIN-WAIT-1 state; + otherwise queue for processing after entering ESTABLISHED state. + + ESTABLISHED STATE + + Queue this until all preceding SENDs have been segmentized, then + form a FIN segment and send it. In any case, enter FIN-WAIT-1 + state. + + FIN-WAIT-1 STATE + FIN-WAIT-2 STATE + + Strictly speaking, this is an error and should receive a "error: + connection closing" response. An "ok" response would be + acceptable, too, as long as a second FIN is not emitted (the first + FIN may be retransmitted though). + + + + + + + + + + + +[Page 60] + + +September 1981 + Transmission Control Protocol + Functional Specification +CLOSE Call + + + + CLOSE-WAIT STATE + + Queue this request until all preceding SENDs have been + segmentized; then send a FIN segment, enter CLOSING state. + + CLOSING STATE + LAST-ACK STATE + TIME-WAIT STATE + + Respond with "error: connection closing". + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + [Page 61] + + + September 1981 +Transmission Control Protocol +Functional Specification + ABORT Call + + + + ABORT Call + + CLOSED STATE (i.e., TCB does not exist) + + If the user should not have access to such a connection, return + "error: connection illegal for this process". + + Otherwise return "error: connection does not exist". + + LISTEN STATE + + Any outstanding RECEIVEs should be returned with "error: + connection reset" responses. Delete TCB, enter CLOSED state, and + return. + + SYN-SENT STATE + + All queued SENDs and RECEIVEs should be given "connection reset" + notification, delete the TCB, enter CLOSED state, and return. + + SYN-RECEIVED STATE + ESTABLISHED STATE + FIN-WAIT-1 STATE + FIN-WAIT-2 STATE + CLOSE-WAIT STATE + + Send a reset segment: + + + + All queued SENDs and RECEIVEs should be given "connection reset" + notification; all segments queued for transmission (except for the + RST formed above) or retransmission should be flushed, delete the + TCB, enter CLOSED state, and return. + + CLOSING STATE + LAST-ACK STATE + TIME-WAIT STATE + + Respond with "ok" and delete the TCB, enter CLOSED state, and + return. + + + + + + + + +[Page 62] + + +September 1981 + Transmission Control Protocol + Functional Specification +STATUS Call + + + + STATUS Call + + CLOSED STATE (i.e., TCB does not exist) + + If the user should not have access to such a connection, return + "error: connection illegal for this process". + + Otherwise return "error: connection does not exist". + + LISTEN STATE + + Return "state = LISTEN", and the TCB pointer. + + SYN-SENT STATE + + Return "state = SYN-SENT", and the TCB pointer. + + SYN-RECEIVED STATE + + Return "state = SYN-RECEIVED", and the TCB pointer. + + ESTABLISHED STATE + + Return "state = ESTABLISHED", and the TCB pointer. + + FIN-WAIT-1 STATE + + Return "state = FIN-WAIT-1", and the TCB pointer. + + FIN-WAIT-2 STATE + + Return "state = FIN-WAIT-2", and the TCB pointer. + + CLOSE-WAIT STATE + + Return "state = CLOSE-WAIT", and the TCB pointer. + + CLOSING STATE + + Return "state = CLOSING", and the TCB pointer. + + LAST-ACK STATE + + Return "state = LAST-ACK", and the TCB pointer. + + + + + + [Page 63] + + + September 1981 +Transmission Control Protocol +Functional Specification + STATUS Call + + + + TIME-WAIT STATE + + Return "state = TIME-WAIT", and the TCB pointer. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Page 64] + + +September 1981 + Transmission Control Protocol + Functional Specification +SEGMENT ARRIVES + + + + SEGMENT ARRIVES + + If the state is CLOSED (i.e., TCB does not exist) then + + all data in the incoming segment is discarded. An incoming + segment containing a RST is discarded. An incoming segment not + containing a RST causes a RST to be sent in response. The + acknowledgment and sequence field values are selected to make the + reset sequence acceptable to the TCP that sent the offending + segment. + + If the ACK bit is off, sequence number zero is used, + + + + If the ACK bit is on, + + + + Return. + + If the state is LISTEN then + + first check for an RST + + An incoming RST should be ignored. Return. + + second check for an ACK + + Any acknowledgment is bad if it arrives on a connection still in + the LISTEN state. An acceptable reset segment should be formed + for any arriving ACK-bearing segment. The RST should be + formatted as follows: + + + + Return. + + third check for a SYN + + If the SYN bit is set, check the security. If the + security/compartment on the incoming segment does not exactly + match the security/compartment in the TCB then send a reset and + return. + + + + + + [Page 65] + + + September 1981 +Transmission Control Protocol +Functional Specification + SEGMENT ARRIVES + + + + If the SEG.PRC is greater than the TCB.PRC then if allowed by + the user and the system set TCB.PRC<-SEG.PRC, if not allowed + send a reset and return. + + + + If the SEG.PRC is less than the TCB.PRC then continue. + + Set RCV.NXT to SEG.SEQ+1, IRS is set to SEG.SEQ and any other + control or text should be queued for processing later. ISS + should be selected and a SYN segment sent of the form: + + + + SND.NXT is set to ISS+1 and SND.UNA to ISS. The connection + state should be changed to SYN-RECEIVED. Note that any other + incoming control or data (combined with SYN) will be processed + in the SYN-RECEIVED state, but processing of SYN and ACK should + not be repeated. If the listen was not fully specified (i.e., + the foreign socket was not fully specified), then the + unspecified fields should be filled in now. + + fourth other text or control + + Any other control or text-bearing segment (not containing SYN) + must have an ACK and thus would be discarded by the ACK + processing. An incoming RST segment could not be valid, since + it could not have been sent in response to anything sent by this + incarnation of the connection. So you are unlikely to get here, + but if you do, drop the segment, and return. + + If the state is SYN-SENT then + + first check the ACK bit + + If the ACK bit is set + + If SEG.ACK =< ISS, or SEG.ACK > SND.NXT, send a reset (unless + the RST bit is set, if so drop the segment and return) + + + + and discard the segment. Return. + + If SND.UNA =< SEG.ACK =< SND.NXT then the ACK is acceptable. + + second check the RST bit + + +[Page 66] + + +September 1981 + Transmission Control Protocol + Functional Specification +SEGMENT ARRIVES + + + + If the RST bit is set + + If the ACK was acceptable then signal the user "error: + connection reset", drop the segment, enter CLOSED state, + delete TCB, and return. Otherwise (no ACK) drop the segment + and return. + + third check the security and precedence + + If the security/compartment in the segment does not exactly + match the security/compartment in the TCB, send a reset + + If there is an ACK + + + + Otherwise + + + + If there is an ACK + + The precedence in the segment must match the precedence in the + TCB, if not, send a reset + + + + If there is no ACK + + If the precedence in the segment is higher than the precedence + in the TCB then if allowed by the user and the system raise + the precedence in the TCB to that in the segment, if not + allowed to raise the prec then send a reset. + + + + If the precedence in the segment is lower than the precedence + in the TCB continue. + + If a reset was sent, discard the segment and return. + + fourth check the SYN bit + + This step should be reached only if the ACK is ok, or there is + no ACK, and it the segment did not contain a RST. + + If the SYN bit is on and the security/compartment and precedence + + + [Page 67] + + + September 1981 +Transmission Control Protocol +Functional Specification + SEGMENT ARRIVES + + + + are acceptable then, RCV.NXT is set to SEG.SEQ+1, IRS is set to + SEG.SEQ. SND.UNA should be advanced to equal SEG.ACK (if there + is an ACK), and any segments on the retransmission queue which + are thereby acknowledged should be removed. + + If SND.UNA > ISS (our SYN has been ACKed), change the connection + state to ESTABLISHED, form an ACK segment + + + + and send it. Data or controls which were queued for + transmission may be included. If there are other controls or + text in the segment then continue processing at the sixth step + below where the URG bit is checked, otherwise return. + + Otherwise enter SYN-RECEIVED, form a SYN,ACK segment + + + + and send it. If there are other controls or text in the + segment, queue them for processing after the ESTABLISHED state + has been reached, return. + + fifth, if neither of the SYN or RST bits is set then drop the + segment and return. + + + + + + + + + + + + + + + + + + + + + + + + +[Page 68] + + +September 1981 + Transmission Control Protocol + Functional Specification +SEGMENT ARRIVES + + + + Otherwise, + + first check sequence number + + SYN-RECEIVED STATE + ESTABLISHED STATE + FIN-WAIT-1 STATE + FIN-WAIT-2 STATE + CLOSE-WAIT STATE + CLOSING STATE + LAST-ACK STATE + TIME-WAIT STATE + + Segments are processed in sequence. Initial tests on arrival + are used to discard old duplicates, but further processing is + done in SEG.SEQ order. If a segment's contents straddle the + boundary between old and new, only the new parts should be + processed. + + There are four cases for the acceptability test for an incoming + segment: + + Segment Receive Test + Length Window + ------- ------- ------------------------------------------- + + 0 0 SEG.SEQ = RCV.NXT + + 0 >0 RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND + + >0 0 not acceptable + + >0 >0 RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND + or RCV.NXT =< SEG.SEQ+SEG.LEN-1 < RCV.NXT+RCV.WND + + If the RCV.WND is zero, no segments will be acceptable, but + special allowance should be made to accept valid ACKs, URGs and + RSTs. + + If an incoming segment is not acceptable, an acknowledgment + should be sent in reply (unless the RST bit is set, if so drop + the segment and return): + + + + After sending the acknowledgment, drop the unacceptable segment + and return. + + + [Page 69] + + + September 1981 +Transmission Control Protocol +Functional Specification + SEGMENT ARRIVES + + + + In the following it is assumed that the segment is the idealized + segment that begins at RCV.NXT and does not exceed the window. + One could tailor actual segments to fit this assumption by + trimming off any portions that lie outside the window (including + SYN and FIN), and only processing further if the segment then + begins at RCV.NXT. Segments with higher begining sequence + numbers may be held for later processing. + + second check the RST bit, + + SYN-RECEIVED STATE + + If the RST bit is set + + If this connection was initiated with a passive OPEN (i.e., + came from the LISTEN state), then return this connection to + LISTEN state and return. The user need not be informed. If + this connection was initiated with an active OPEN (i.e., came + from SYN-SENT state) then the connection was refused, signal + the user "connection refused". In either case, all segments + on the retransmission queue should be removed. And in the + active OPEN case, enter the CLOSED state and delete the TCB, + and return. + + ESTABLISHED + FIN-WAIT-1 + FIN-WAIT-2 + CLOSE-WAIT + + If the RST bit is set then, any outstanding RECEIVEs and SEND + should receive "reset" responses. All segment queues should be + flushed. Users should also receive an unsolicited general + "connection reset" signal. Enter the CLOSED state, delete the + TCB, and return. + + CLOSING STATE + LAST-ACK STATE + TIME-WAIT + + If the RST bit is set then, enter the CLOSED state, delete the + TCB, and return. + + + + + + + + +[Page 70] + + +September 1981 + Transmission Control Protocol + Functional Specification +SEGMENT ARRIVES + + + + third check security and precedence + + SYN-RECEIVED + + If the security/compartment and precedence in the segment do not + exactly match the security/compartment and precedence in the TCB + then send a reset, and return. + + ESTABLISHED STATE + + If the security/compartment and precedence in the segment do not + exactly match the security/compartment and precedence in the TCB + then send a reset, any outstanding RECEIVEs and SEND should + receive "reset" responses. All segment queues should be + flushed. Users should also receive an unsolicited general + "connection reset" signal. Enter the CLOSED state, delete the + TCB, and return. + + Note this check is placed following the sequence check to prevent + a segment from an old connection between these ports with a + different security or precedence from causing an abort of the + current connection. + + fourth, check the SYN bit, + + SYN-RECEIVED + ESTABLISHED STATE + FIN-WAIT STATE-1 + FIN-WAIT STATE-2 + CLOSE-WAIT STATE + CLOSING STATE + LAST-ACK STATE + TIME-WAIT STATE + + If the SYN is in the window it is an error, send a reset, any + outstanding RECEIVEs and SEND should receive "reset" responses, + all segment queues should be flushed, the user should also + receive an unsolicited general "connection reset" signal, enter + the CLOSED state, delete the TCB, and return. + + If the SYN is not in the window this step would not be reached + and an ack would have been sent in the first step (sequence + number check). + + + + + + + [Page 71] + + + September 1981 +Transmission Control Protocol +Functional Specification + SEGMENT ARRIVES + + + + fifth check the ACK field, + + if the ACK bit is off drop the segment and return + + if the ACK bit is on + + SYN-RECEIVED STATE + + If SND.UNA =< SEG.ACK =< SND.NXT then enter ESTABLISHED state + and continue processing. + + If the segment acknowledgment is not acceptable, form a + reset segment, + + + + and send it. + + ESTABLISHED STATE + + If SND.UNA < SEG.ACK =< SND.NXT then, set SND.UNA <- SEG.ACK. + Any segments on the retransmission queue which are thereby + entirely acknowledged are removed. Users should receive + positive acknowledgments for buffers which have been SENT and + fully acknowledged (i.e., SEND buffer should be returned with + "ok" response). If the ACK is a duplicate + (SEG.ACK < SND.UNA), it can be ignored. If the ACK acks + something not yet sent (SEG.ACK > SND.NXT) then send an ACK, + drop the segment, and return. + + If SND.UNA < SEG.ACK =< SND.NXT, the send window should be + updated. If (SND.WL1 < SEG.SEQ or (SND.WL1 = SEG.SEQ and + SND.WL2 =< SEG.ACK)), set SND.WND <- SEG.WND, set + SND.WL1 <- SEG.SEQ, and set SND.WL2 <- SEG.ACK. + + Note that SND.WND is an offset from SND.UNA, that SND.WL1 + records the sequence number of the last segment used to update + SND.WND, and that SND.WL2 records the acknowledgment number of + the last segment used to update SND.WND. The check here + prevents using old segments to update the window. + + + + + + + + + +[Page 72] + + +September 1981 + Transmission Control Protocol + Functional Specification +SEGMENT ARRIVES + + + + FIN-WAIT-1 STATE + + In addition to the processing for the ESTABLISHED state, if + our FIN is now acknowledged then enter FIN-WAIT-2 and continue + processing in that state. + + FIN-WAIT-2 STATE + + In addition to the processing for the ESTABLISHED state, if + the retransmission queue is empty, the user's CLOSE can be + acknowledged ("ok") but do not delete the TCB. + + CLOSE-WAIT STATE + + Do the same processing as for the ESTABLISHED state. + + CLOSING STATE + + In addition to the processing for the ESTABLISHED state, if + the ACK acknowledges our FIN then enter the TIME-WAIT state, + otherwise ignore the segment. + + LAST-ACK STATE + + The only thing that can arrive in this state is an + acknowledgment of our FIN. If our FIN is now acknowledged, + delete the TCB, enter the CLOSED state, and return. + + TIME-WAIT STATE + + The only thing that can arrive in this state is a + retransmission of the remote FIN. Acknowledge it, and restart + the 2 MSL timeout. + + sixth, check the URG bit, + + ESTABLISHED STATE + FIN-WAIT-1 STATE + FIN-WAIT-2 STATE + + If the URG bit is set, RCV.UP <- max(RCV.UP,SEG.UP), and signal + the user that the remote side has urgent data if the urgent + pointer (RCV.UP) is in advance of the data consumed. If the + user has already been signaled (or is still in the "urgent + mode") for this continuous sequence of urgent data, do not + signal the user again. + + + + [Page 73] + + + September 1981 +Transmission Control Protocol +Functional Specification + SEGMENT ARRIVES + + + + CLOSE-WAIT STATE + CLOSING STATE + LAST-ACK STATE + TIME-WAIT + + This should not occur, since a FIN has been received from the + remote side. Ignore the URG. + + seventh, process the segment text, + + ESTABLISHED STATE + FIN-WAIT-1 STATE + FIN-WAIT-2 STATE + + Once in the ESTABLISHED state, it is possible to deliver segment + text to user RECEIVE buffers. Text from segments can be moved + into buffers until either the buffer is full or the segment is + empty. If the segment empties and carries an PUSH flag, then + the user is informed, when the buffer is returned, that a PUSH + has been received. + + When the TCP takes responsibility for delivering the data to the + user it must also acknowledge the receipt of the data. + + Once the TCP takes responsibility for the data it advances + RCV.NXT over the data accepted, and adjusts RCV.WND as + apporopriate to the current buffer availability. The total of + RCV.NXT and RCV.WND should not be reduced. + + Please note the window management suggestions in section 3.7. + + Send an acknowledgment of the form: + + + + This acknowledgment should be piggybacked on a segment being + transmitted if possible without incurring undue delay. + + + + + + + + + + + + +[Page 74] + + +September 1981 + Transmission Control Protocol + Functional Specification +SEGMENT ARRIVES + + + + CLOSE-WAIT STATE + CLOSING STATE + LAST-ACK STATE + TIME-WAIT STATE + + This should not occur, since a FIN has been received from the + remote side. Ignore the segment text. + + eighth, check the FIN bit, + + Do not process the FIN if the state is CLOSED, LISTEN or SYN-SENT + since the SEG.SEQ cannot be validated; drop the segment and + return. + + If the FIN bit is set, signal the user "connection closing" and + return any pending RECEIVEs with same message, advance RCV.NXT + over the FIN, and send an acknowledgment for the FIN. Note that + FIN implies PUSH for any segment text not yet delivered to the + user. + + SYN-RECEIVED STATE + ESTABLISHED STATE + + Enter the CLOSE-WAIT state. + + FIN-WAIT-1 STATE + + If our FIN has been ACKed (perhaps in this segment), then + enter TIME-WAIT, start the time-wait timer, turn off the other + timers; otherwise enter the CLOSING state. + + FIN-WAIT-2 STATE + + Enter the TIME-WAIT state. Start the time-wait timer, turn + off the other timers. + + CLOSE-WAIT STATE + + Remain in the CLOSE-WAIT state. + + CLOSING STATE + + Remain in the CLOSING state. + + LAST-ACK STATE + + Remain in the LAST-ACK state. + + + [Page 75] + + + September 1981 +Transmission Control Protocol +Functional Specification + SEGMENT ARRIVES + + + + TIME-WAIT STATE + + Remain in the TIME-WAIT state. Restart the 2 MSL time-wait + timeout. + + and return. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Page 76] + + +September 1981 + Transmission Control Protocol + Functional Specification +USER TIMEOUT + + + + USER TIMEOUT + + For any state if the user timeout expires, flush all queues, signal + the user "error: connection aborted due to user timeout" in general + and for any outstanding calls, delete the TCB, enter the CLOSED + state and return. + + RETRANSMISSION TIMEOUT + + For any state if the retransmission timeout expires on a segment in + the retransmission queue, send the segment at the front of the + retransmission queue again, reinitialize the retransmission timer, + and return. + + TIME-WAIT TIMEOUT + + If the time-wait timeout expires on a connection delete the TCB, + enter the CLOSED state and return. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + [Page 77] + + + September 1981 +Transmission Control Protocol + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Page 78] + + +September 1981 + Transmission Control Protocol + + + + GLOSSARY + + + +1822 + BBN Report 1822, "The Specification of the Interconnection of + a Host and an IMP". The specification of interface between a + host and the ARPANET. + +ACK + A control bit (acknowledge) occupying no sequence space, which + indicates that the acknowledgment field of this segment + specifies the next sequence number the sender of this segment + is expecting to receive, hence acknowledging receipt of all + previous sequence numbers. + +ARPANET message + The unit of transmission between a host and an IMP in the + ARPANET. The maximum size is about 1012 octets (8096 bits). + +ARPANET packet + A unit of transmission used internally in the ARPANET between + IMPs. The maximum size is about 126 octets (1008 bits). + +connection + A logical communication path identified by a pair of sockets. + +datagram + A message sent in a packet switched computer communications + network. + +Destination Address + The destination address, usually the network and host + identifiers. + +FIN + A control bit (finis) occupying one sequence number, which + indicates that the sender will send no more data or control + occupying sequence space. + +fragment + A portion of a logical unit of data, in particular an internet + fragment is a portion of an internet datagram. + +FTP + A file transfer protocol. + + + + + + [Page 79] + + + September 1981 +Transmission Control Protocol +Glossary + + + +header + Control information at the beginning of a message, segment, + fragment, packet or block of data. + +host + A computer. In particular a source or destination of messages + from the point of view of the communication network. + +Identification + An Internet Protocol field. This identifying value assigned + by the sender aids in assembling the fragments of a datagram. + +IMP + The Interface Message Processor, the packet switch of the + ARPANET. + +internet address + A source or destination address specific to the host level. + +internet datagram + The unit of data exchanged between an internet module and the + higher level protocol together with the internet header. + +internet fragment + A portion of the data of an internet datagram with an internet + header. + +IP + Internet Protocol. + +IRS + The Initial Receive Sequence number. The first sequence + number used by the sender on a connection. + +ISN + The Initial Sequence Number. The first sequence number used + on a connection, (either ISS or IRS). Selected on a clock + based procedure. + +ISS + The Initial Send Sequence number. The first sequence number + used by the sender on a connection. + +leader + Control information at the beginning of a message or block of + data. In particular, in the ARPANET, the control information + on an ARPANET message at the host-IMP interface. + + + +[Page 80] + + +September 1981 + Transmission Control Protocol + Glossary + + + +left sequence + This is the next sequence number to be acknowledged by the + data receiving TCP (or the lowest currently unacknowledged + sequence number) and is sometimes referred to as the left edge + of the send window. + +local packet + The unit of transmission within a local network. + +module + An implementation, usually in software, of a protocol or other + procedure. + +MSL + Maximum Segment Lifetime, the time a TCP segment can exist in + the internetwork system. Arbitrarily defined to be 2 minutes. + +octet + An eight bit byte. + +Options + An Option field may contain several options, and each option + may be several octets in length. The options are used + primarily in testing situations; for example, to carry + timestamps. Both the Internet Protocol and TCP provide for + options fields. + +packet + A package of data with a header which may or may not be + logically complete. More often a physical packaging than a + logical packaging of data. + +port + The portion of a socket that specifies which logical input or + output channel of a process is associated with the data. + +process + A program in execution. A source or destination of data from + the point of view of the TCP or other host-to-host protocol. + +PUSH + A control bit occupying no sequence space, indicating that + this segment contains data that must be pushed through to the + receiving user. + +RCV.NXT + receive next sequence number + + + + [Page 81] + + + September 1981 +Transmission Control Protocol +Glossary + + + +RCV.UP + receive urgent pointer + +RCV.WND + receive window + +receive next sequence number + This is the next sequence number the local TCP is expecting to + receive. + +receive window + This represents the sequence numbers the local (receiving) TCP + is willing to receive. Thus, the local TCP considers that + segments overlapping the range RCV.NXT to + RCV.NXT + RCV.WND - 1 carry acceptable data or control. + Segments containing sequence numbers entirely outside of this + range are considered duplicates and discarded. + +RST + A control bit (reset), occupying no sequence space, indicating + that the receiver should delete the connection without further + interaction. The receiver can determine, based on the + sequence number and acknowledgment fields of the incoming + segment, whether it should honor the reset command or ignore + it. In no case does receipt of a segment containing RST give + rise to a RST in response. + +RTP + Real Time Protocol: A host-to-host protocol for communication + of time critical information. + +SEG.ACK + segment acknowledgment + +SEG.LEN + segment length + +SEG.PRC + segment precedence value + +SEG.SEQ + segment sequence + +SEG.UP + segment urgent pointer field + + + + + +[Page 82] + + +September 1981 + Transmission Control Protocol + Glossary + + + +SEG.WND + segment window field + +segment + A logical unit of data, in particular a TCP segment is the + unit of data transfered between a pair of TCP modules. + +segment acknowledgment + The sequence number in the acknowledgment field of the + arriving segment. + +segment length + The amount of sequence number space occupied by a segment, + including any controls which occupy sequence space. + +segment sequence + The number in the sequence field of the arriving segment. + +send sequence + This is the next sequence number the local (sending) TCP will + use on the connection. It is initially selected from an + initial sequence number curve (ISN) and is incremented for + each octet of data or sequenced control transmitted. + +send window + This represents the sequence numbers which the remote + (receiving) TCP is willing to receive. It is the value of the + window field specified in segments from the remote (data + receiving) TCP. The range of new sequence numbers which may + be emitted by a TCP lies between SND.NXT and + SND.UNA + SND.WND - 1. (Retransmissions of sequence numbers + between SND.UNA and SND.NXT are expected, of course.) + +SND.NXT + send sequence + +SND.UNA + left sequence + +SND.UP + send urgent pointer + +SND.WL1 + segment sequence number at last window update + +SND.WL2 + segment acknowledgment number at last window update + + + + [Page 83] + + + September 1981 +Transmission Control Protocol +Glossary + + + +SND.WND + send window + +socket + An address which specifically includes a port identifier, that + is, the concatenation of an Internet Address with a TCP port. + +Source Address + The source address, usually the network and host identifiers. + +SYN + A control bit in the incoming segment, occupying one sequence + number, used at the initiation of a connection, to indicate + where the sequence numbering will start. + +TCB + Transmission control block, the data structure that records + the state of a connection. + +TCB.PRC + The precedence of the connection. + +TCP + Transmission Control Protocol: A host-to-host protocol for + reliable communication in internetwork environments. + +TOS + Type of Service, an Internet Protocol field. + +Type of Service + An Internet Protocol field which indicates the type of service + for this internet fragment. + +URG + A control bit (urgent), occupying no sequence space, used to + indicate that the receiving user should be notified to do + urgent processing as long as there is data to be consumed with + sequence numbers less than the value indicated in the urgent + pointer. + +urgent pointer + A control field meaningful only when the URG bit is on. This + field communicates the value of the urgent pointer which + indicates the data octet associated with the sending user's + urgent call. + + + + + +[Page 84] + + +September 1981 + Transmission Control Protocol + + + + REFERENCES + + + +[1] Cerf, V., and R. Kahn, "A Protocol for Packet Network + Intercommunication", IEEE Transactions on Communications, + Vol. COM-22, No. 5, pp 637-648, May 1974. + +[2] Postel, J. (ed.), "Internet Protocol - DARPA Internet Program + Protocol Specification", RFC 791, USC/Information Sciences + Institute, September 1981. + +[3] Dalal, Y. and C. Sunshine, "Connection Management in Transport + Protocols", Computer Networks, Vol. 2, No. 6, pp. 454-473, + December 1978. + +[4] Postel, J., "Assigned Numbers", RFC 790, USC/Information Sciences + Institute, September 1981. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + [Page 85] + + +! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +ack + ^ self flags anyMask: 16 + +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +ack: aBoolean + self flags: (aBoolean ifTrue: [self flags bitOr: 16r10] ifFalse: [self flags bitClear: 16r10]) +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +ackSequence + ^ TCPSequenceNumber value: (self longAt: 9) +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +ackSequence: aTCPSequenceNumber + self longAt: 9 put: aTCPSequenceNumber asInteger +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum + ^ self shortAt: 17 +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum: anInteger + self shortAt: 17 put: anInteger +! ! + +!TCPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +computeChecksum + ^ self normalizeChecksum: self envelope pseudoHeaderChecksum + (self checksumFrom: 1 to: self size) +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +dataOffset + ^ (self flags bitShift: -12) * 4 +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +dataOffset: anInteger + self resetFlags: 16rF000. + self setFlags: (anInteger // 4 bitShift: 12) +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination + ^ self shortAt: 3 +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination: anInteger + self shortAt: 3 put: anInteger +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +fin + ^ self flags anyMask: 1 +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +fin: aBoolean + self flags: (aBoolean ifTrue: [self flags bitOr: 16r01] ifFalse: [self flags bitClear: 16r01]) +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +flags + ^ self shortAt: 13 +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +flags: anInteger + self shortAt: 13 put: anInteger +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ self dataOffset +! ! + +!TCPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +lastSequence + "Answer the last sequence number for this packet." + | answer | + answer := self sequence + self length - 1. + self syn ifTrue: [answer := answer + 1]. + self fin ifTrue: [answer := answer + 1]. + ^ answer +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + ^ self envelope length - self envelope headerSize - self headerSize +! ! + +!TCPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +mss + ^ (self options detect: [:one | one isKindOf: MSS] ifNone: [^ nil]) value +! ! + +!TCPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextSequence + ^ self lastSequence + 1 +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +options + | answer index option | + answer := OrderedCollection new. + index := 20. + [index >= self headerSize] + whileFalse: [option := TCPOption bytes: bytes offset: offset + index. + option size = 0 ifTrue: [^ self error: 'Zero size option']. + index := index + option size. + option isEOL ifTrue: [^ answer]. + answer add: option]. + ^ answer +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pointer + "Answer the urgent pointer." + ^ self shortAt: 19 +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +pointer: anInteger + "Set the urgent pointer." + self shortAt: 19 put: anInteger +! ! + +!TCPPacket methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: 'TCP '; print: self source; nextPutAll: ' -> '; print: self destination. + (self envelope notNil and: [self fin | self syn | self rst or: [self length > 0]]) + ifTrue: [aStream space; print: self sequence asInteger; nextPut: $:; print: self lastSequence "(self sequence + self length)" asInteger; nextPut: $(; print: self length; nextPut: $)]. + #(fin psh rst syn urg xxx yyy) do: [ :each | (self perform: each) ifTrue: [aStream space; nextPutAll: each]]. + self ack ifTrue: [aStream nextPutAll: ' ack '; print: self ackSequence asInteger]. + aStream nextPutAll: ' win '; print: self windowSize. + self options do: [ :each | aStream space; print: each]. + self length > 0 ifTrue: [aStream space; print: ((self rawData asString collect: [:each| each isAlphaNumeric ifTrue: [each] ifFalse: [$.]]) truncateWithElipsisTo: 32)] +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +psh + ^ self flags anyMask: 8 +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +psh: aBoolean + self flags: (aBoolean ifTrue: [self flags bitOr: 16r08] ifFalse: [self flags bitClear: 16r08]) +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +rawData + ^ self copyFrom: self headerSize + 1 to: self headerSize + self length +! ! + +!TCPPacket methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +resetFlags: aNumber + ^ self shortAt: 13 put: (self flags bitAnd: aNumber bitInvert) + +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +rst + ^ self flags anyMask: 4 +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +rst: aBoolean + self flags: (aBoolean ifTrue: [self flags bitOr: 16r04] ifFalse: [self flags bitClear: 16r04]) +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence + ^ TCPSequenceNumber value: (self longAt: 5) +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence: aTCPSequenceNumber + self longAt: 5 put: aTCPSequenceNumber asInteger +! ! + +!TCPPacket methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +setFlags: aNumber + ^ self shortAt: 13 put: (self flags bitOr: aNumber) +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +source + ^ self shortAt: 1 +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +source: anInteger + self shortAt: 1 put: anInteger +! ! + +!TCPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +swapSourceAndDestination + | oldSource | + oldSource := self source. + self source: self destination. + self destination: oldSource +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +syn + ^ self flags anyMask: 2 +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +syn: aBoolean + self flags: (aBoolean ifTrue: [self flags bitOr: 16r02] ifFalse: [self flags bitClear: 16r02]) +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +urg + ^ self flags anyMask: 32 + +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +urg: aBoolean + self flags: (aBoolean ifTrue: [self flags bitOr: 16r20] ifFalse: [self flags bitClear: 16r20]) +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +windowSize + ^ self shortAt: 15 +! ! + +!TCPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +windowSize: anInteger + self shortAt: 15 put: anInteger +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +xxx + ^ self flags allMask: 16r40 +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +xxx: aBoolean + self flags: (aBoolean ifTrue: [self flags bitOr: 16r40] ifFalse: [self flags bitClear: 16r40]) +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +yyy + ^ self flags allMask: 16r80 +! ! + +!TCPPacket methodsFor: 'accessing flags' stamp: 'KenD 28/Jun/2026 13:32:25'! +yyy: aBoolean + self flags: (aBoolean ifTrue: [self flags bitOr: 16r80] ifFalse: [self flags bitClear: 16r80]) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPPacket class' category: 'SqueakNOS-Net-Packets'! +TCPPacket class + instanceVariableNames: ''! + +!TCPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ 20 +! ! + +!TCPPacket class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new: anInteger + ^ (super new: anInteger) + dataOffset: self headerSize +! ! + +!TCPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ 6 +! ! + +!TCPPacket class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +with: aPacket headerSize: anInteger + ^ (super with: aPacket headerSize: anInteger) + dataOffset: anInteger +! ! + + diff --git a/modules/NOS/Network/Packets/UDPPacket.Class.st b/modules/NOS/Network/Packets/UDPPacket.Class.st new file mode 100644 index 00000000..dbc605fd --- /dev/null +++ b/modules/NOS/Network/Packets/UDPPacket.Class.st @@ -0,0 +1,260 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #UDPPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #UDPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!UDPPacket commentStamp: '' prior: 0! + +Internet RFC/STD/FYI/BCP Archives + + + + RFC768 + + [ Index | Search | What's New | Comments | Help ] + + + +RFC 768 J. Postel + ISI + 28 August 1980 + + User Datagram Protocol + ---------------------- + +Introduction +------------ + +This User Datagram Protocol (UDP) is defined to make available a +datagram mode of packet-switched computer communication in the +environment of an interconnected set of computer networks. This +protocol assumes that the Internet Protocol (IP) [1] is used as the +underlying protocol. + +This protocol provides a procedure for application programs to send +messages to other programs with a minimum of protocol mechanism. The +protocol is transaction oriented, and delivery and duplicate protection +are not guaranteed. Applications requiring ordered reliable delivery of +streams of data should use the Transmission Control Protocol (TCP) [2]. + +Format +------ + + 0 7 8 15 16 23 24 31 + +--------+--------+--------+--------+ + | Source | Destination | + | Port | Port | + +--------+--------+--------+--------+ + | | | + | Length | Checksum | + +--------+--------+--------+--------+ + | + | data octets ... + +---------------- ... + + User Datagram Header Format + +Fields +------ + +Source Port is an optional field, when meaningful, it indicates the port +of the sending process, and may be assumed to be the port to which a +reply should be addressed in the absence of any other information. If +not used, a value of zero is inserted. + +Postel [page 1] + + 28 Aug 1980 +User Datagram Protocol RFC 768 +Fields + +Destination Port has a meaning within the context of a particular +internet destination address. + +Length is the length in octets of this user datagram including this +header and the data. (This means the minimum value of the length is +eight.) + +Checksum is the 16-bit one's complement of the one's complement sum of a +pseudo header of information from the IP header, the UDP header, and the +data, padded with zero octets at the end (if necessary) to make a +multiple of two octets. + +The pseudo header conceptually prefixed to the UDP header contains the +source address, the destination address, the protocol, and the UDP +length. This information gives protection against misrouted datagrams. +This checksum procedure is the same as is used in TCP. + + 0 7 8 15 16 23 24 31 + +--------+--------+--------+--------+ + | source address | + +--------+--------+--------+--------+ + | destination address | + +--------+--------+--------+--------+ + | zero |protocol| UDP length | + +--------+--------+--------+--------+ + +If the computed checksum is zero, it is transmitted as all ones (the +equivalent in one's complement arithmetic). An all zero transmitted +checksum value means that the transmitter generated no checksum (for +debugging or for higher level protocols that don't care). + +User Interface +-------------- + +A user interface should allow + + the creation of new receive ports, + + receive operations on the receive ports that return the data octets + and an indication of source port and source address, + + and an operation that allows a datagram to be sent, specifying the + data, source and destination ports and addresses to be sent. + +[page 2] Postel + +28 Aug 1980 +RFC 768 User Datagram Protocol + IP Interface + +IP Interface +------------- + +The UDP module must be able to determine the source and destination +internet addresses and the protocol field from the internet header. One +possible UDP/IP interface would return the whole internet datagram +including all of the internet header in response to a receive operation. +Such an interface would also allow the UDP to pass a full internet +datagram complete with header to the IP to send. The IP would verify +certain fields for consistency and compute the internet header checksum. + +Protocol Application +-------------------- + +The major uses of this protocol is the Internet Name Server [3], and the +Trivial File Transfer [4]. + +Protocol Number +--------------- + +This is protocol 17 (21 octal) when used in the Internet Protocol. +Other protocol numbers are listed in [5]. + +References +---------- + +[1] Postel, J., "Internet Protocol," RFC 760, USC/Information + Sciences Institute, January 1980. + +[2] Postel, J., "Transmission Control Protocol," RFC 761, + USC/Information Sciences Institute, January 1980. + +[3] Postel, J., "Internet Name Server," USC/Information Sciences + Institute, IEN 116, August 1979. + +[4] Sollins, K., "The TFTP Protocol," Massachusetts Institute of + Technology, IEN 133, January 1980. + +[5] Postel, J., "Assigned Numbers," USC/Information Sciences + Institute, RFC 762, January 1980. + +Postel [page 3] + + + + [ Index | Search | What's New | Comments | Help ] + + Comments/Questions about this archive ? Send mail to rfc-admin@faqs.org + + +! + +!UDPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum + ^ self shortAt: 7 +! ! + +!UDPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +checksum: anInteger + self shortAt: 7 put: anInteger +! ! + +!UDPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +computeChecksum + ^ self normalizeChecksum: self envelope pseudoHeaderChecksum + (self checksumFrom: 1 to: self size) +! ! + +!UDPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination + ^ self shortAt: 3 +! ! + +!UDPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination: anInteger + self shortAt: 3 put: anInteger +! ! + +!UDPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length + ^ self shortAt: 5 +! ! + +!UDPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +length: anInteger + self shortAt: 5 put: anInteger +! ! + +!UDPPacket methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: 'UDP '; print: self source; nextPutAll: ' -> '; print: self destination; space; print: self rawData asString +! ! + +!UDPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +source + ^ self shortAt: 1 +! ! + +!UDPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +source: anInteger + self shortAt: 1 put: anInteger +! ! + +!UDPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +swapSourceAndDestination + | oldSource | + oldSource := self source. + self source: self destination. + self destination: oldSource +! ! + +!UDPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +verifiesChecksum + ^ self checksum = 0 or: [super verifiesChecksum] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'UDPPacket class' category: 'SqueakNOS-Net-Packets'! +UDPPacket class + instanceVariableNames: ''! + +!UDPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fieldsNames + ^ #(source destination length checksum) +! ! + +!UDPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ 8 +! ! + +!UDPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ 17 +! ! + + diff --git a/modules/NOS/Network/Packets/WirelessPacket.Class.st b/modules/NOS/Network/Packets/WirelessPacket.Class.st new file mode 100644 index 00000000..5082c438 --- /dev/null +++ b/modules/NOS/Network/Packets/WirelessPacket.Class.st @@ -0,0 +1,230 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #WirelessPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #WirelessPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!WirelessPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination + ^ EthernetAddress bytes: (self copyFrom: 11 to: 16) +! ! + +!WirelessPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +duration + "Only meaningful for data frames." + ^ self shortAt: 3 +! ! + +!WirelessPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fcs + "Answer the Frame Check Sequence (32-bit CRC)." + ^ self longAt: 31 +! ! + +!WirelessPacket methodsFor: 'accessing-private' stamp: 'KenD 28/Jun/2026 13:32:25'! +frameControl + ^ self shortAt: 1 +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +fromDS + ^ (self frameControl bitShift: -9) odd +! ! + +!WirelessPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +id + "Answer the associated identity of the transmitting station. + Only meaningful for control frames." + ^ self shortAt: 3 +! ! + +!WirelessPacket methodsFor: 'testing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +isACK + ^ self isControl and: [self subtype = 2r1101] +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isATIM + ^ self isManagement and: [self subtype = 2r1001] +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isAssociationRequest + ^ self isManagement and: [self subtype = 2r0000] +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isAssociationResponse + ^ self isManagement and: [self subtype = 2r0001] +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isAuthentication + ^ self isManagement and: [self subtype = 2r1011] +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isBeacon + ^ self isManagement and: [self subtype = 2r1000] +! ! + +!WirelessPacket methodsFor: 'testing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +isCTS + ^ self isControl and: [self subtype = 2r1100] +! ! + +!WirelessPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isControl + ^ self type = 2r01 +! ! + +!WirelessPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isData + ^ self type = 2r10 +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isDeauthentication + ^ self isManagement and: [self subtype = 2r1100] +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isDisassociation + ^ self isManagement and: [self subtype = 2r1010] +! ! + +!WirelessPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isManagement + ^ self type = 2r00 +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isProbeRequest + ^ self isManagement and: [self subtype = 2r0100] +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isProbeResponse + ^ self isManagement and: [self subtype = 2r0101] +! ! + +!WirelessPacket methodsFor: 'testing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +isRTS + ^ self isControl and: [self subtype = 2r1011] +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isReasociationRequest + ^ self isManagement and: [self subtype = 2r0010] +! ! + +!WirelessPacket methodsFor: 'testing-management' stamp: 'KenD 28/Jun/2026 13:32:25'! +isReasociationResponse + ^ self isManagement and: [self subtype = 2r0011] +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +md + "More data flag." + ^ (self frameControl bitShift: -13) odd +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +mf + "More fragments flag." + ^ (self frameControl bitShift: -10) odd +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +order + ^ (self frameControl bitShift: -15) = 1 +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +pm + "Power management flag." + ^ (self frameControl bitShift: -12) odd +! ! + +!WirelessPacket methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: '802.11 '; nextPutAll: self typeName; nextPut: $/; nextPutAll: self subtypeName. + aStream space; print: self source. + self size > 10 ifTrue: [aStream nextPutAll: ' -> '; print: self destination] +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +retry + "Answer true if this is a retransmission." + ^ (self frameControl bitShift: -11) odd +! ! + +!WirelessPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +rx + "Answer the receiving wireless station." + ^ EthernetAddress bytes: (self copyFrom: 17 to: 22) +! ! + +!WirelessPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence + ^ self shortAt: 23 +! ! + +!WirelessPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +source + ^ EthernetAddress bytes: (self copyFrom: 5 to: 10) +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +subtype + ^ (self frameControl bitShift: -4) bitAnd: 2r1111 +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +subtypeName + self isManagement ifTrue: [^ #(AssociationRequest AssociationResponse ReassociationRequest ReassociationResponse ProbeRequest ProbeResponse Reserved Reserved Beacon ATIM Disassociation Authentication Deathentication Reserved Reserved Reserved) at: self subtype + 1]. + self isControl ifTrue: [^ #(Reserved Reserved Reserved Reserved Reserved Reserved Reserved Reserved Reserved Reserved 'PS-Poll' RTS CTS ACK 'CF-End' 'CF-End+CF-ACK') at: self subtype + 1]. + self isData ifTrue: [^ #(Data 'Data+CF-ACK' 'Data+CF-Poll' 'Data+CF-ACK+CF-Poll' Null 'CF-ACK' 'CF-Poll' 'CF-ACK+CF-Poll' Reserved Reserved Reserved Reserved Reserved Reserved Reserved Reserved) at: self subtype + 1]. + ^ #Reserved +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +toDS + ^ (self frameControl bitShift: -8) odd +! ! + +!WirelessPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +tx + "Answer the transmitting wireless station." + ^ EthernetAddress bytes: (self copyFrom: 25 to: 30) +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ (self frameControl bitShift: -2) bitAnd: 2r11 +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +typeName + ^ #(Management Data Control Reserved) at: self type + 1 +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +version + ^ self frameControl bitAnd: 2r11 +! ! + +!WirelessPacket methodsFor: 'accessing-control' stamp: 'KenD 28/Jun/2026 13:32:25'! +wep + ^ (self frameControl bitShift: -14) odd +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WirelessPacket class' category: 'SqueakNOS-Net-Packets'! +WirelessPacket class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/Ethernet/ARP.Class.st b/modules/NOS/Network/Protocols/Ethernet/ARP.Class.st new file mode 100644 index 00000000..f6fab451 --- /dev/null +++ b/modules/NOS/Network/Protocols/Ethernet/ARP.Class.st @@ -0,0 +1,167 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ARP category: 'SqueakNOS-Net-Protocols-Ethernet'! +Conduit subclass: #ARP + instanceVariableNames: 'entries requests routes' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-Ethernet'! +!ARP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ aPacket isKindOf: ARPPacket +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: aNetAddress + ^ self at: aNetAddress ifAbsent: [] +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: aNetAddress ifAbsent: exceptionBlock + entries do: [ :each | each protocol = aNetAddress ifTrue: [^ each hardware]]. + ^ self + at: (routes gatewayTo: aNetAddress ifNone: [^ exceptionBlock value]) gateway + ifAbsent: exceptionBlock +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: aProtocolAddress put: aHardwareAddress + (entries detect: [ :one | one protocol = aProtocolAddress] ifNone: [entries add: ARPEntry new]) + protocol: aProtocolAddress; + hardware: aHardwareAddress +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +cacheAt: aProtocolAddress put: aHardwareAddress + (entries detect: [ :one | one protocol = aProtocolAddress] ifNone: [entries add: (ARPEntry new timeout: timer time + self keepMilliseconds)]) + protocol: aProtocolAddress; + hardware: aHardwareAddress +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +flush + "Flush the cache." + entries := entries select: [ :each | each isStatic]. + requests := OrderedCollection new +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hardwareAddress + ^ left address +! ! + +!ARP methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +includes: aNetAddress + ^ (self at: aNetAddress ifAbsent: []) notNil +! ! + +!ARP methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + entries := Set new. + routes := RoutingTable new. + self flush +! ! + +!ARP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: anARPPacket + anARPPacket isRequest + ifTrue: [self cacheAt: anARPPacket senderProtocolAddress put: anARPPacket senderHardwareAddress. + self processRequest: anARPPacket]. + anARPPacket isReply + ifTrue: [self processReply: anARPPacket]. + ^ super input: anARPPacket +! ! + +!ARP methodsFor: 'timers' stamp: 'KenD 28/Jun/2026 13:32:25'! +keepMilliseconds + ^ 20 * 60 * 1000 +! ! + +!ARP methodsFor: 'timers' stamp: 'KenD 28/Jun/2026 13:32:25'! +pauseMilliseconds + ^ 20 * 1000 +! ! + +!ARP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +processReply: anARPPacket + (requests detect: [ :one | one protocol = anARPPacket senderProtocolAddress] ifNone: [^ self]) reply: anARPPacket +! ! + +!ARP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +processRequest: anARPPacket + | ethernet | + anARPPacket targetProtocolAddress = self protocolAddress ifFalse: [^ self]. + anARPPacket + opcodeName: #Reply; + swapSenderAndTarget; + senderHardwareAddress: self hardwareAddress. + (ethernet := anARPPacket envelope) + destination: anARPPacket targetHardwareAddress. + self << ethernet +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocolAddress + ^ (entries detect: [ :one | one hardware = self hardwareAddress] ifNone: [^ nil]) protocol +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocolAddress: aNetAddress + self at: aNetAddress put: self hardwareAddress +! ! + +!ARP methodsFor: 'timers' stamp: 'KenD 28/Jun/2026 13:32:25'! +prune + entries := entries select: [ :each | each isStatic or: [each timeout > timer time]] +! ! + +!ARP methodsFor: 'timers' stamp: 'KenD 28/Jun/2026 13:32:25'! +pruneMilliseconds + ^ 5 * 60 * 1000 +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +request: aNetAddress enqueue: aPacket + | request | + request := + requests detect: [ :one | one protocol = aNetAddress] + ifNone: [requests add: (ARPRequest new arp: self; protocol: aNetAddress; retryTime: timer time)]. + request enqueue: aPacket. + request retryTime >= timer time + ifFalse: [request tries \\ 5 = 0 ifTrue: [HostDown new address: aNetAddress; signal]. + ^ self]. + request send. + request retryTime: timer time + (request tries \\ 5 = 0 ifTrue: [self retryMilliseconds] ifFalse: [self pauseMilliseconds]) +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +requests + ^ requests +! ! + +!ARP methodsFor: 'timers' stamp: 'KenD 28/Jun/2026 13:32:25'! +retryMilliseconds + ^ 1000 +! ! + +!ARP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +routes + ^ routes +! ! + +!ARP methodsFor: 'timers' stamp: 'KenD 28/Jun/2026 13:32:25'! +schedule + super schedule. + timer every: self pruneMilliseconds send: #prune to: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ARP class' category: 'SqueakNOS-Net-Protocols-Ethernet'! +ARP class + instanceVariableNames: ''! + + +ARP initialize! + diff --git a/modules/NOS/Network/Protocols/Ethernet/ARPEntry.Class.st b/modules/NOS/Network/Protocols/Ethernet/ARPEntry.Class.st new file mode 100644 index 00000000..9700e7e1 --- /dev/null +++ b/modules/NOS/Network/Protocols/Ethernet/ARPEntry.Class.st @@ -0,0 +1,71 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ARPEntry category: 'SqueakNOS-Net-Protocols-Ethernet'! +Object subclass: #ARPEntry + instanceVariableNames: 'hardware protocol timeout' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-Ethernet'! +!ARPEntry methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:32:25'! += anARPEntry + ^ self protocol = anARPEntry protocol +! ! + +!ARPEntry methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hardware + ^ hardware +! ! + +!ARPEntry methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hardware: aNetAddress + hardware := aNetAddress +! ! + +!ARPEntry methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hash + ^ self protocol hash +! ! + +!ARPEntry methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isDynamic + ^ self isStatic not +! ! + +!ARPEntry methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isStatic + ^ timeout isNil +! ! + +!ARPEntry methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream print: hardware; nextPutAll: ' -> '; print: protocol. + self isStatic ifTrue: [aStream nextPutAll: ' (STATIC)'] +! ! + +!ARPEntry methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ protocol +! ! + +!ARPEntry methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol: aNetAddress + protocol := aNetAddress +! ! + +!ARPEntry methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +timeout + ^ timeout +! ! + +!ARPEntry methodsFor: 'accesing' stamp: 'KenD 28/Jun/2026 13:32:25'! +timeout: anInteger + timeout := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ARPEntry class' category: 'SqueakNOS-Net-Protocols-Ethernet'! +ARPEntry class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/Ethernet/ARPPacket.Class.st b/modules/NOS/Network/Protocols/Ethernet/ARPPacket.Class.st new file mode 100644 index 00000000..54a66741 --- /dev/null +++ b/modules/NOS/Network/Protocols/Ethernet/ARPPacket.Class.st @@ -0,0 +1,195 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ARPPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #ARPPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hardwareClass + NetAddress allSubclassesDo: [ :each | each type = self hardwareType ifTrue: [^ each]]. + ^ nil +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hardwareSize + ^ self at: 5 +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hardwareSize: anInteger + self at: 5 put: anInteger. + +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hardwareType + ^ self shortAt: 1 +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hardwareType: anInteger + self shortAt: 1 put: anInteger +! ! + +!ARPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isReply + ^ self opcode = 2 +! ! + +!ARPPacket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isRequest + ^ self opcode = 1 +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +opcode + ^ self shortAt: 7 +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +opcode: anInteger + self shortAt: 7 put: anInteger +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +opcodeName + ^ self opcodeNames at: self opcode ifAbsent: [] +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +opcodeName: aSymbol + ^ self opcode: (self opcodeNames indexOf: aSymbol) +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +opcodeNames + ^ #(Request Reply RRequest RReply InRequest InReply NAK) +! ! + +!ARPPacket methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: 'ARP '. + self isRequest + ifTrue: [aStream nextPutAll: 'who-has '; print: self targetProtocolAddress; nextPutAll: ' tell '; print: self senderHardwareAddress. + ^ self]. + self isReply + ifTrue: [aStream print: self senderProtocolAddress; nextPutAll: ' is-at '; print: self senderHardwareAddress. + ^ self]. + aStream nextPutAll: self opcodeName asString +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocolClass + NetAddress allSubclassesDo: [ :each | each type = self protocolType ifTrue: [^ each]]. + ^ nil +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocolSize + ^ self at: 6 +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocolSize: anInteger + self at: 6 put: anInteger. + +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocolType + ^ self shortAt: 3 +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocolType: anInteger + self shortAt: 3 put: anInteger +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +senderHardwareAddress + ^ (self hardwareClass ifNil: [^ nil]) + bytes: (self copyFrom: 9 to: 9 - 1 + self hardwareSize) +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +senderHardwareAddress: aNetAddress + self hardwareType: aNetAddress class type. + self hardwareSize: aNetAddress size. + self replaceFrom: 9 to: 9 - 1 + aNetAddress size with: aNetAddress asByteArray +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +senderProtocolAddress + ^ (self protocolClass ifNil: [^ nil]) + bytes: (self copyFrom: 9 + self hardwareSize to: 8 + self hardwareSize + self protocolSize) +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +senderProtocolAddress: aNetAddress + self protocolType: aNetAddress class type. + self protocolSize: aNetAddress size. + self replaceFrom: 9 + self hardwareSize to: 8 + self hardwareSize + aNetAddress size with: aNetAddress asByteArray +! ! + +!ARPPacket methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:32:25'! +swapSenderAndTarget + | oldAddress | + oldAddress := self senderHardwareAddress. + self senderHardwareAddress: self targetHardwareAddress. + self targetHardwareAddress: oldAddress. + + oldAddress := self senderProtocolAddress. + self senderProtocolAddress: self targetProtocolAddress. + self targetProtocolAddress: oldAddress +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +targetHardwareAddress + ^ (self hardwareClass ifNil: [^ nil]) + bytes: (self copyFrom: 9 + self hardwareSize + self protocolSize to: 9 - 1 + (self hardwareSize*2) + self protocolSize) +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +targetHardwareAddress: aNetAddress + self hardwareType: aNetAddress class type. + self hardwareSize: aNetAddress size. + self replaceFrom: 9 + self hardwareSize + self protocolSize to: 9 - 1 + (self hardwareSize*2) + self protocolSize with: aNetAddress asByteArray +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +targetProtocolAddress + ^ (self protocolClass ifNil: [^ nil]) + bytes: (self copyFrom: 9 + (self hardwareSize * 2) + self protocolSize to: 9 - 1 + (self hardwareSize + self protocolSize * 2)) +! ! + +!ARPPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +targetProtocolAddress: aNetAddress + self protocolType: aNetAddress class type. + self protocolSize: aNetAddress size. + self replaceFrom: 9 + (self hardwareSize * 2) + self protocolSize to: 8 + (self hardwareSize + self protocolSize * 2) with: aNetAddress asByteArray +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ARPPacket class' category: 'SqueakNOS-Net-Packets'! +ARPPacket class + instanceVariableNames: ''! + +!ARPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +etherType + ^ 16r806 +! ! + +!ARPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fieldsNames + ^ #(hardwareAddressFormat protocolAddressFormat hardwareAddressLength protocolAddressLength opcode opcodeName) +! ! + +!ARPPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ 7 +! ! + + diff --git a/modules/NOS/Network/Protocols/Ethernet/ARPRequest.Class.st b/modules/NOS/Network/Protocols/Ethernet/ARPRequest.Class.st new file mode 100644 index 00000000..1ed54366 --- /dev/null +++ b/modules/NOS/Network/Protocols/Ethernet/ARPRequest.Class.st @@ -0,0 +1,94 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ARPRequest category: 'SqueakNOS-Net-Protocols-Ethernet'! +Object subclass: #ARPRequest + instanceVariableNames: 'arp protocol retryTime pendingPackets tries' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-Ethernet'! +!ARPRequest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +arp: anARP + arp := anARP +! ! + +!ARPRequest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +delete + arp requests remove: self ifAbsent: [] +! ! + +!ARPRequest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +enqueue: aPacket + pendingPackets add: aPacket +! ! + +!ARPRequest methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + pendingPackets := OrderedCollection new: 1. + tries := 0 +! ! + +!ARPRequest methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: 'who-has '; print: protocol; nextPutAll: ' ('; print: tries; nextPutAll: ' tries, '; print: pendingPackets size; nextPutAll: ' packets pending)' +! ! + +!ARPRequest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ protocol +! ! + +!ARPRequest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol: aNetAddress + protocol := aNetAddress +! ! + +!ARPRequest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +reply: anARPPacket + arp cacheAt: anARPPacket senderProtocolAddress put: anARPPacket senderHardwareAddress. + pendingPackets do: [ :each | arp << each]. + self delete +! ! + +!ARPRequest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +retryTime + ^ retryTime +! ! + +!ARPRequest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +retryTime: time + retryTime := time +! ! + +!ARPRequest methodsFor: 'old api' stamp: 'KenD 28/Jun/2026 13:32:25'! +send + | packet ethernet | + tries := tries + 1. + packet := (ARPPacket new: 42) + opcodeName: #Request; + senderHardwareAddress: arp hardwareAddress; + senderProtocolAddress: arp protocolAddress; + targetProtocolAddress: protocol. + ethernet := (EthernetPacket with: packet) + destination: EthernetAddress broadcast. + arp << ethernet +! ! + +!ARPRequest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +tries + ^ tries +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ARPRequest class' category: 'SqueakNOS-Net-Protocols-Ethernet'! +ARPRequest class + instanceVariableNames: ''! + +!ARPRequest class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^ super new initialize +! ! + + +ARPRequest initialize! + diff --git a/modules/NOS/Network/Protocols/Ethernet/Ethernet.Class.st b/modules/NOS/Network/Protocols/Ethernet/Ethernet.Class.st new file mode 100644 index 00000000..9e738ebd --- /dev/null +++ b/modules/NOS/Network/Protocols/Ethernet/Ethernet.Class.st @@ -0,0 +1,60 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #Ethernet category: 'SqueakNOS-Net-Protocols-Ethernet'! +Conduit subclass: #Ethernet + instanceVariableNames: 'address arp' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-Ethernet'! +!Ethernet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address + ^ address +! ! + +!Ethernet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address: anEthernetAddress + address := anEthernetAddress +! ! + +!Ethernet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +arp + ^ arp +! ! + +!Ethernet methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + self | (arp := ARP new) +! ! + +!Ethernet methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: packet + (packet destination isBroadcast or: [address isNil or: [packet destination = address]]) ifFalse: [^ self]. + super input: packet data +! ! + +!Ethernet methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mtu + ^ super mtu - EthernetPacket headerSize +! ! + +!Ethernet methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +output: aPacket + | destination | + (aPacket isKindOf: EthernetPacket) + ifTrue: [address notNil ifTrue: [aPacket source: address]. + ^ super output: aPacket]. + (destination := arp at: aPacket destination ifAbsent: []) isNil + ifFalse: [^ super output: ((EthernetPacket with: aPacket) source: address; destination: destination)]. + arp request: aPacket destination enqueue: aPacket +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Ethernet class' category: 'SqueakNOS-Net-Protocols-Ethernet'! +Ethernet class + instanceVariableNames: ''! + + +Ethernet initialize! + diff --git a/modules/NOS/Network/Protocols/Ethernet/EthernetAddress.Class.st b/modules/NOS/Network/Protocols/Ethernet/EthernetAddress.Class.st new file mode 100644 index 00000000..047e7119 --- /dev/null +++ b/modules/NOS/Network/Protocols/Ethernet/EthernetAddress.Class.st @@ -0,0 +1,71 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #EthernetAddress category: 'SqueakNOS-Net-Support'! +NetAddress subclass: #EthernetAddress + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Support'! +!EthernetAddress methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +asInteger + ^ (bytes unsignedShortAt: 5) << 16 + (bytes unsignedShortAt: 3) << 16 + (bytes unsignedShortAt: 1) + +! ! + +!EthernetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isBroadcast + ^ self bytes allSatisfy: [ :each | each = 255] +! ! + +!EthernetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isMulticast + ^ (self bytes at: 1) = 16r01 + and: [(self bytes at: 2) = 16r00 + and: [(self bytes at: 3) = 16r5E]] +! ! + +!EthernetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isUnicast + ^ self isBroadcast not and: [self isMulticast not] +! ! + +!EthernetAddress methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + self bytes + do: [ :each | + aStream + nextPut: ('0123456789ABCDEF' at: each // 16 + 1); + nextPut: ('0123456789ABCDEF' at: each \\ 16 + 1)] + separatedBy: [aStream nextPut: $:] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'EthernetAddress class' category: 'SqueakNOS-Net-Support'! +EthernetAddress class + instanceVariableNames: ''! + +!EthernetAddress class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +broadcast + ^ self bytes: #(255 255 255 255 255 255) +! ! + +!EthernetAddress class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +fromInteger: anInteger + ^ self bytes: (anInteger asByteArrayOfSize: 6) reversed +! ! + +!EthernetAddress class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +fromString: aString + "Return the internet address represented by the given string. The string should contain four positive decimal integers delimited by periods, commas, or spaces, where each integer represents one address byte. Return nil if the string is not a host address in an acceptable format." + "self fromString: '00:48:54:85:CC:51'" + + ^ self bytes: ((aString findTokens: ':- ') collect: [ :each | Integer readFrom: each readStream base: 16]) +! ! + +!EthernetAddress class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ 1 +! ! + + diff --git a/modules/NOS/Network/Protocols/Ethernet/EthernetInterface.Class.st b/modules/NOS/Network/Protocols/Ethernet/EthernetInterface.Class.st new file mode 100644 index 00000000..d0913cbb --- /dev/null +++ b/modules/NOS/Network/Protocols/Ethernet/EthernetInterface.Class.st @@ -0,0 +1,69 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #EthernetInterface category: 'SqueakNOS-Net-Interfaces'! +NetInterface subclass: #EthernetInterface + instanceVariableNames: 'ethernet ip' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Interfaces'! +!EthernetInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +device: aDevice + super device: aDevice. + ethernet address: aDevice macAddress +! ! + +!EthernetInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +down + self ethernet arp timerDown. + self ip tcp timerDown. + super down +! ! + +!EthernetInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +ethernet + ^ ethernet +! ! + +!EthernetInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + ip := IP new. + ip | TCP new. + ip | UDP new. + ethernet := Ethernet new. + self | PluggableConduit transcripter | ethernet | ip +! ! + +!EthernetInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +internetAddress: anInternetAddress + ip address: anInternetAddress. + ethernet arp protocolAddress: anInternetAddress +! ! + +!EthernetInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +ip + ^ ip +! ! + +!EthernetInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +macAddress: anEthernetAddress + ethernet address: anEthernetAddress. + device macAddress: anEthernetAddress +! ! + +!EthernetInterface methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +up + super up. + self ethernet arp timerUp. + self ip tcp timerUp +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'EthernetInterface class' category: 'SqueakNOS-Net-Interfaces'! +EthernetInterface class + instanceVariableNames: ''! + + +EthernetInterface initialize! + diff --git a/modules/NOS/Network/Protocols/Ethernet/EthernetPacket.Class.st b/modules/NOS/Network/Protocols/Ethernet/EthernetPacket.Class.st new file mode 100644 index 00000000..cb5da18b --- /dev/null +++ b/modules/NOS/Network/Protocols/Ethernet/EthernetPacket.Class.st @@ -0,0 +1,79 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #EthernetPacket category: 'SqueakNOS-Net-Packets'! +Packet subclass: #EthernetPacket + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Packets'! +!EthernetPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +data + | type | + type := self type. + Packet allSubclassesDo: [ :each | each etherType = type ifTrue: [^ each on: self]]. + ^ nil +! ! + +!EthernetPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination + ^ EthernetAddress bytes: (self copyFrom: 1 to: 6) +! ! + +!EthernetPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination: anEthernetAddress + self replaceFrom: 1 to: 6 with: anEthernetAddress asByteArray +! ! + +!EthernetPacket methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: 'Ether '; print: self source; nextPutAll: ' -> '; print: self destination +! ! + +!EthernetPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +source + ^ EthernetAddress bytes: (self copyFrom: 7 to: 12) +! ! + +!EthernetPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +source: anEthernetAddress + self replaceFrom: 7 to: 12 with: anEthernetAddress asByteArray +! ! + +!EthernetPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ self shortAt: 13 +! ! + +!EthernetPacket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type: anInteger + self shortAt: 13 put: anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'EthernetPacket class' category: 'SqueakNOS-Net-Packets'! +EthernetPacket class + instanceVariableNames: ''! + +!EthernetPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fieldsNames + ^ #(destination source type) +! ! + +!EthernetPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +headerSize + ^ 14 +! ! + +!EthernetPacket class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +protocol + ^ 97 +! ! + +!EthernetPacket class methodsFor: 'instances creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +with: aPacket headerSize: anInteger + ^ (super with: aPacket headerSize: anInteger) + type: aPacket class etherType +! ! + + diff --git a/modules/NOS/Network/Protocols/Ethernet/Route.Class.st b/modules/NOS/Network/Protocols/Ethernet/Route.Class.st new file mode 100644 index 00000000..51a936df --- /dev/null +++ b/modules/NOS/Network/Protocols/Ethernet/Route.Class.st @@ -0,0 +1,52 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #Route category: 'SqueakNOS-Net-Protocols-Ethernet'! +Object subclass: #Route + instanceVariableNames: 'destination gateway interface' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-Ethernet'! +!Route methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination + ^ destination +! ! + +!Route methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination: aNetBlock + destination := aNetBlock +! ! + +!Route methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +gateway + ^ gateway +! ! + +!Route methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +gateway: aNetAddress + gateway := aNetAddress +! ! + +!Route methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +interface + ^ interface +! ! + +!Route methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +interface: aNetInterface + interface := aNetInterface +! ! + +!Route methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream print: self destination; nextPutAll: ' -> '. + self gateway isNil ifFalse: [aStream print: self gateway; nextPutAll: ' -> ']. + aStream print: self interface +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Route class' category: 'SqueakNOS-Net-Protocols-Ethernet'! +Route class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/Ethernet/RoutingTable.Class.st b/modules/NOS/Network/Protocols/Ethernet/RoutingTable.Class.st new file mode 100644 index 00000000..b8eca0a0 --- /dev/null +++ b/modules/NOS/Network/Protocols/Ethernet/RoutingTable.Class.st @@ -0,0 +1,67 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #RoutingTable category: 'SqueakNOS-Net-Protocols-Ethernet'! +Object subclass: #RoutingTable + instanceVariableNames: 'routes default' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-Ethernet'! +!RoutingTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +add: aRoute + ^ routes add: aRoute +! ! + +!RoutingTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +default + ^ default +! ! + +!RoutingTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +default: aRouteOrNil + default := aRouteOrNil +! ! + +!RoutingTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +gatewayTo: aNetAddress ifNone: exceptionBlock + ^ routes detect: [ :one | (one destination includes: aNetAddress) and: [one gateway notNil and: [one gateway ~= aNetAddress]]] ifNone: exceptionBlock +! ! + +!RoutingTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + routes := OrderedCollection new +! ! + +!RoutingTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +remove: aRoute + ^ routes remove: aRoute +! ! + +!RoutingTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +routeTo: aNetAddress + ^ self routeTo: aNetAddress ifNone: [default] +! ! + +!RoutingTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +routeTo: aNetAddress ifNone: exceptionBlock + ^ routes detect: [ :one | one destination includes: aNetAddress] ifNone: exceptionBlock +! ! + +!RoutingTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +routes + ^ routes +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RoutingTable class' category: 'SqueakNOS-Net-Protocols-Ethernet'! +RoutingTable class + instanceVariableNames: ''! + +!RoutingTable class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^ super new initialize +! ! + + +RoutingTable initialize! + diff --git a/modules/NOS/Network/Protocols/IP/ICMP.Class.st b/modules/NOS/Network/Protocols/IP/ICMP.Class.st new file mode 100644 index 00000000..4730ddf3 --- /dev/null +++ b/modules/NOS/Network/Protocols/IP/ICMP.Class.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ICMP category: 'SqueakNOS-Net-Protocols-IP'! +Conduit subclass: #ICMP + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-IP'! +!ICMP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ aPacket isKindOf: ICMPPacket +! ! + +!ICMP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: anICMPPacket + | answer | + anICMPPacket verifiesChecksum ifFalse: [^ self error: 'Bad checksum']. + anICMPPacket isTimestampRequest + ifTrue: [(answer := anICMPPacket envelope copy) data + type: 14; "TimestampReply" + receiveTimestamp: self timestamp; + transmitTimestamp: self timestamp; + setChecksum. + answer swapSourceAndDestination. + ^ self << answer]. + anICMPPacket isEchoRequest + ifTrue: [(answer := anICMPPacket envelope copy) data + type: 0; "EchoReply" + setChecksum. + answer swapSourceAndDestination. + ^ self << answer]. + anICMPPacket isDestinationUnreachable + ifTrue: [self triggerEvent: #destinationUnreachable: with: anICMPPacket]. + super input: anICMPPacket +! ! + +!ICMP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +timestamp + "Answer the number of milliseconds past midnight, UTC." + ^ Time millisecondClockValue +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ICMP class' category: 'SqueakNOS-Net-Protocols-IP'! +ICMP class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/IP/IP.Class.st b/modules/NOS/Network/Protocols/IP/IP.Class.st new file mode 100644 index 00000000..b6988bc7 --- /dev/null +++ b/modules/NOS/Network/Protocols/IP/IP.Class.st @@ -0,0 +1,103 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IP category: 'SqueakNOS-Net-Protocols-IP'! +Conduit subclass: #IP + instanceVariableNames: 'address reassembler raw' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-IP'! +!IP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ (aPacket isKindOf: IPPacket) and: [aPacket version = 4 and: [address isNil or: [aPacket destination = address]]] +! ! + +!IP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address + ^ address +! ! + +!IP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address: anInternetAddress + address := anInternetAddress +! ! + +!IP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +icmp + ^ self findA: ICMP +! ! + +!IP methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + reassembler := IPReassembler new. + reassembler > self. + self < reassembler. + self | ICMP new. + raw := Conduit new +! ! + +!IP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: anIPPacket + anIPPacket verifiesChecksum ifFalse: [^ self error: 'Bad checksum']. + anIPPacket source isUnicast ifFalse: [^ self error: 'Bad source address']. + anIPPacket isFragment + ifTrue: [anIPPacket >> reassembler] + ifFalse: [anIPPacket >> raw. + super input: anIPPacket data] +! ! + +!IP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mtu + ^ super mtu - IPPacket headerSize +! ! + +!IP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +output: aPacket + | data | + address isNil ifFalse: [aPacket source: address]. + aPacket ttl = 0 ifTrue: [aPacket ttl: 255]. + aPacket id: 65536 atRandom - 1. + aPacket setChecksum. + (data := aPacket data) ifNotNil: [data setChecksum]. + aPacket size <= self mtu + ifTrue: [super output: aPacket] + ifFalse: [Transcript cr; show: 'FRAGMENTING!!'. + (aPacket fragmentsSized: self mtu) do: [ :each | super output: each]] +! ! + +!IP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +raw + ^ raw +! ! + +!IP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +tcp + ^ self findA: TCP +! ! + +!IP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +udp + ^ self findA: UDP +! ! + +!IP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +undeliverable: aPacket + | icmp ip | + icmp := (ICMPPacket quote: aPacket envelope) + typeName: #DestinationUnreachable; + codeName: #ProtocolUnreachable. + ip := (IPPacket with: icmp) + source: aPacket envelope destination; + destination: aPacket envelope source. + self << ip +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IP class' category: 'SqueakNOS-Net-Protocols-IP'! +IP class + instanceVariableNames: ''! + + +IP initialize! + diff --git a/modules/NOS/Network/Protocols/IP/IPChannel.Class.st b/modules/NOS/Network/Protocols/IP/IPChannel.Class.st new file mode 100644 index 00000000..a945bc2f --- /dev/null +++ b/modules/NOS/Network/Protocols/IP/IPChannel.Class.st @@ -0,0 +1,109 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPChannel category: 'SqueakNOS-Net-Protocols-IP'! +Conduit subclass: #IPChannel + instanceVariableNames: 'localAddress remoteAddress reassembler ttl tos df options' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-IP'! +!IPChannel methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ (aPacket isKindOf: IPPacket) + and: [aPacket version = 4 + and: [(localAddress isNil or: [aPacket destination = localAddress]) + and: [remoteAddress isNil or: [aPacket source = remoteAddress]]]] +! ! + +!IPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +df + ^ df +! ! + +!IPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +df: aBoolean + df := aBoolean +! ! + +!IPChannel methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + reassembler := IPReassembler new. + reassembler > self. + self < reassembler. + + ttl := 255. + tos := 0. + df := false. + options := #() +! ! + +!IPChannel methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: anIPPacket + anIPPacket verifiesChecksum ifFalse: [^ self error: 'Bad checksum']. + anIPPacket isFragment + ifTrue: [anIPPacket >> reassembler] + ifFalse: [super input: anIPPacket data] +! ! + +!IPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mtu + ^ super mtu - IPPacket headerSize "- options size" +! ! + +!IPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +options + ^ options +! ! + +!IPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +options: aCollection + options := aCollection +! ! + +!IPChannel methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +output: aPacket + | ip | + (ip := IPPacket with: aPacket options: options) source: localAddress; + destination: remoteAddress; + ttl: ttl; + tos: tos; + df: df; + id: 65536 atRandom - 1. + ip setChecksum. + ip data setChecksum. + ip size <= self mtu + ifTrue: [super output: ip] + ifFalse: [Transcript cr; show: 'FRAGMENTING!!'. + (ip fragmentsSized: self mtu) + do: [:each | super output: each]] +! ! + +!IPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +tos + ^ tos +! ! + +!IPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +tos: anInteger + tos := anInteger +! ! + +!IPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +ttl + ^ ttl +! ! + +!IPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +ttl: anInteger + ttl := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPChannel class' category: 'SqueakNOS-Net-Protocols-IP'! +IPChannel class + instanceVariableNames: ''! + + +IPChannel initialize! + diff --git a/modules/NOS/Network/Protocols/IP/IPReassembler.Class.st b/modules/NOS/Network/Protocols/IP/IPReassembler.Class.st new file mode 100644 index 00000000..703b04b7 --- /dev/null +++ b/modules/NOS/Network/Protocols/IP/IPReassembler.Class.st @@ -0,0 +1,54 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPReassembler category: 'SqueakNOS-Net-Protocols-IP'! +Conduit subclass: #IPReassembler + instanceVariableNames: 'lists' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-IP'! +!IPReassembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + lists := Heap sortBlock: [ :a :b | a timeout < b timeout] +! ! + +!IPReassembler methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: anIPPacket + | reassemblyList | + anIPPacket isFragment ifFalse: [^ super input: anIPPacket]. + reassemblyList := lists detect: [ :one | one matches: anIPPacket] ifNone: [lists add: (IPReassemblyList new timeout: timer time + 20000)]. + reassemblyList add: anIPPacket. + reassemblyList isComplete ifFalse: [^ self]. + lists remove: reassemblyList. + super input: reassemblyList packet +! ! + +!IPReassembler methodsFor: 'timers' stamp: 'KenD 28/Jun/2026 13:32:25'! +prune + | reassemblyList icmp ip | + [lists notEmpty and: [lists first timeout < timer time]] + whileTrue: [reassemblyList := lists removeFirst. + (icmp := ICMPPacket quote: reassemblyList fragments first) + typeName: #TimeExceeded; + codeName: #FragmentationReassemblyTimeExceeded. + (ip := IPPacket with: icmp) + destination: reassemblyList source; + id: reassemblyList id. + self << ip] +! ! + +!IPReassembler methodsFor: 'timers' stamp: 'KenD 28/Jun/2026 13:32:25'! +schedule + super schedule. + timer every: 5000 "msecs" send: #prune to: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPReassembler class' category: 'SqueakNOS-Net-Protocols-IP'! +IPReassembler class + instanceVariableNames: ''! + + +IPReassembler initialize! + diff --git a/modules/NOS/Network/Protocols/IP/IPReassemblyList.Class.st b/modules/NOS/Network/Protocols/IP/IPReassemblyList.Class.st new file mode 100644 index 00000000..c6a48378 --- /dev/null +++ b/modules/NOS/Network/Protocols/IP/IPReassemblyList.Class.st @@ -0,0 +1,93 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPReassemblyList category: 'SqueakNOS-Net-Protocols-IP'! +Object subclass: #IPReassemblyList + instanceVariableNames: 'fragments timeout' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-IP'! +!IPReassemblyList methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +add: aPacket + ^ fragments add: aPacket +! ! + +!IPReassemblyList methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +destination + ^ fragments first destination +! ! + +!IPReassemblyList methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fragments + ^ fragments +! ! + +!IPReassemblyList methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +id + ^ fragments first id +! ! + +!IPReassemblyList methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + fragments := SortedCollection sortBlock: [ :a :b | a fragmentOffset <= b fragmentOffset] +! ! + +!IPReassemblyList methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isComplete + fragments last mf ifTrue: [^ false]. + fragments first fragmentOffset = 0 ifFalse: [^ false]. + fragments size > 1 ifFalse: [^ false]. + 1 to: fragments size - 1 do: [ :each | + (fragments at: each) fragmentOffset + (fragments at: each) length < (fragments at: each+1) fragmentOffset ifTrue: [^ false]]. + ^ true +! ! + +!IPReassemblyList methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +matches: aPacket + | aFragment | + aFragment := fragments first. + ^ aFragment id = aPacket id and: [aFragment source = aPacket source and: [aFragment destination = aPacket destination]] +! ! + +!IPReassemblyList methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +packet + | answer start | + answer := IPPacket new: fragments last fragmentOffset + fragments last length - fragments last headerSize. + answer replaceFrom: 1 to: fragments first headerSize with: fragments first startingAt: 1. + answer mf: false. + fragments do: [ :each | + start := answer headerSize + 1 + each fragmentOffset. + answer replaceFrom: start to: start + each length - each headerSize - 1 with: each startingAt: each headerSize + 1]. + answer length: answer size. + answer setChecksum. + ^ answer +! ! + +!IPReassemblyList methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +source + ^ fragments first source +! ! + +!IPReassemblyList methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +timeout + ^ timeout +! ! + +!IPReassemblyList methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +timeout: anInteger + timeout := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPReassemblyList class' category: 'SqueakNOS-Net-Protocols-IP'! +IPReassemblyList class + instanceVariableNames: ''! + +!IPReassemblyList class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^ super new initialize +! ! + + +IPReassemblyList initialize! + diff --git a/modules/NOS/Network/Protocols/TCP/InternalTCPSocket.Class.st b/modules/NOS/Network/Protocols/TCP/InternalTCPSocket.Class.st new file mode 100644 index 00000000..f6a108c0 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/InternalTCPSocket.Class.st @@ -0,0 +1,408 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #InternalTCPSocket category: 'SqueakNOS-Net-Protocols-TCP'! +InternalSocket subclass: #InternalTCPSocket + instanceVariableNames: 'localPort remotePort remoteAddress mss windowSize reassembler state sendingWindowSize sequence sender lastAcknowledged finSequence delayedAck' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP'! +!InternalTCPSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +abort + "Close immediatly. Don't try to send any queued data." + + state abort +! ! + +!InternalTCPSocket methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ aPacket destination = localPort and: [(remotePort isNil or: [aPacket source = remotePort]) and: [remoteAddress isNil or: [aPacket envelope source = remoteAddress]]] +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +acknowledged: aTCPSequenceNumber + lastAcknowledged := lastAcknowledged max: aTCPSequenceNumber +! ! + +!InternalTCPSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + state close +! ! + +!InternalTCPSocket methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +closeAndDestroy: timeoutSeconds + self close +! ! + +!InternalTCPSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +connect + state connect +! ! + +!InternalTCPSocket methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +dataAvailable + ^ reassembler dataAvailable +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +finAcknowledged + ^ lastAcknowledged >= finSequence +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstUnacknowledged + ^ lastAcknowledged + 1 +! ! + +!InternalTCPSocket methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + windowSize := 4096. + mss := 536. "1460." + reassembler := TCPReassembler new. + self state: TCPClosed new. + + sequence := TCPSequenceNumber value: 16r100000000 atRandom - 1. + lastAcknowledged := sequence - 1. + sendingWindowSize := 1. "whatever" + self sender: TCPIdle new +! ! + +!InternalTCPSocket methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + state input: aPacket +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +isAllAcknowledged + ^ lastAcknowledged = sequence +! ! + +!InternalTCPSocket methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +isOtherEndClosed + ^ state isKindOf: TCPClosed +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +lastAcknowledged + ^ lastAcknowledged +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +lastError: anError + "lastError _ anError" +! ! + +!InternalTCPSocket methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +left: aTCP + super left: aTCP. + timer := aTCP timer +! ! + +!InternalTCPSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +listen + state listen +! ! + +!InternalTCPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +localPort + ^ localPort +! ! + +!InternalTCPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +localPort: anInteger + localPort := anInteger +! ! + +!InternalTCPSocket methodsFor: 'timer' stamp: 'KenD 28/Jun/2026 13:32:25'! +maximumSegmentLifetime + ^ 60000 "1 minute" +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +mss + ^ mss +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +mss: anInteger + mss := anInteger +! ! + +!InternalTCPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +next: anInteger into: aByteArray startingAt: startIndex + "Read the next anInteger bytes into aByteArray, starting at startIndex. Answer the number of bytes actually read." + ^ reassembler next: anInteger into: aByteArray startingAt: startIndex +! ! + +!InternalTCPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: aTCPPacket + | ip | + aTCPPacket + source: self localPort; + destination: self remotePort; + windowSize: self windowSize; + sequence: self sequence. + ip := IPPacket with: aTCPPacket. + ip destination: self remoteAddress; ttl: self ttl. + self << ip. + self sequence: aTCPPacket nextSequence +! ! + +!InternalTCPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: anInteger from: aByteArray startingAt: startIndex + "Write the next anInteger elements in aByteArray, starting at startIndex. Answer the number of bytes actually written." + + | tcp | + self flag: #todo. "this should be implemented in tcp states" + tcp := TCPPacket new: anInteger. + tcp replaceFrom: tcp headerSize + 1 to: tcp size with: aByteArray asByteArray startingAt: startIndex. + tcp psh: true; source: self localPort; destination: self remotePort. + tcp ack: true; ackSequence: reassembler nextSequence. + timer removeAlarm: #sendAckImmediatly for: self. + self nextPut: tcp. + ^ anInteger +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +offeredWindow + "Answer the 'offered' or 'maximum send' window, i.e. the range of sequence + numbers for bytes that either have been sent but are not (yet) aknowledged + or have not been sent but may be sent." + ^ lastAcknowledged + 1 to: lastAcknowledged + sendingWindowSize +! ! + +!InternalTCPSocket methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPutAll: 'TCP Socket '. + localPort notNil ifTrue: [aStream nextPutAll: 'at '; print: localPort; space]. + remoteAddress notNil ifTrue: [aStream nextPutAll: 'to '; print: remoteAddress; nextPut: $:; print: remotePort; space]. + aStream space; nextPut: $(; nextPutAll: state name; space; nextPutAll: sender name; nextPut: $) +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +reassembler + ^ reassembler +! ! + +!InternalTCPSocket methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +receiveDataTimeout: seconds into: buffer + ^ self receiveDataTimeout: seconds into: buffer startingAt: 1 +! ! + +!InternalTCPSocket methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +receiveDataTimeout: seconds into: buffer startingAt: index + self waitForReadabilityTimeoutAfter: seconds * 1000. + ^ self next: buffer size - index + 1 into: buffer startingAt: index +! ! + +!InternalTCPSocket methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +receiveSomeDataInto: aStringOrByteArray + "Receive data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data." + + ^self receiveSomeDataInto: aStringOrByteArray startingAt: 1 +! ! + +!InternalTCPSocket methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +receiveSomeDataInto: buffer startingAt: index + "Receive data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data." + + ^ self next: buffer size - index + 1 into: buffer startingAt: index +! ! + +!InternalTCPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +remoteAddress + ^ remoteAddress +! ! + +!InternalTCPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +remoteAddress: anInternetAddress + remoteAddress := anInternetAddress +! ! + +!InternalTCPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePort + ^ remotePort +! ! + +!InternalTCPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePort: anInteger + remotePort := anInteger +! ! + +!InternalTCPSocket methodsFor: 'timer' stamp: 'KenD 28/Jun/2026 13:32:25'! +rescheduleRetransmitTimer + self scheduleRetransmitAfter: 1000 +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +reset: aPacket + "Send a RESET in response to aPacket." + | tcp ip | + aPacket rst ifTrue: [^ self]. + tcp := (TCPPacket new: 0) + source: aPacket destination; + destination: aPacket source; + rst: true. + aPacket ack + ifTrue: [tcp sequence: aPacket ackSequence] + ifFalse: [tcp ackSequence: aPacket nextSequence; ack: true]. + (ip := IPPacket with: tcp) + destination: aPacket envelope source. + self << ip +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +retransmit + sender retransmit +! ! + +!InternalTCPSocket methodsFor: 'timer' stamp: 'KenD 28/Jun/2026 13:32:25'! +scheduleRetransmitAfter: msecs + Transcript cr; show: 'schedule retransmit'. + timer removeAlarm: #retransmit for: self. + timer after: msecs send: #retransmit to: self +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendAck + timer after: 200 send: #sendAckImmediatly to: self +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendAckImmediatly + | tcp | + tcp := (TCPPacket new: 0) + ack: true; + ackSequence: reassembler nextSequence. + self nextPut: tcp. + timer removeAlarm: #sendAckImmediatly for: self +! ! + +!InternalTCPSocket methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendData: aByteArray + ^ self nextPut: aByteArray size from: aByteArray startingAt: 1 +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendFin + | tcp | + tcp := (TCPPacket new: 0) + fin: true. + self nextPut: tcp. + finSequence := tcp sequence +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendSyn + | tcp | + tcp := (TCPPacket new: 0) + syn: true. +" tcp options: (Array with: (MSS new value: mss))." + self nextPut: tcp +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendSynAck + | tcp | + tcp := (TCPPacket new: 0) + syn: true; + ack: true; + ackSequence: reassembler nextSequence. + self nextPut: tcp +! ! + +!InternalTCPSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +sender + ^ sender +! ! + +!InternalTCPSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +sender: aTCPOutputState + Transcript cr; show: self printString, ' -> ', aTCPOutputState name. + aTCPOutputState socket: self. + sender := aTCPOutputState +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendingWindowSize + ^ sendingWindowSize +! ! + +!InternalTCPSocket methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence + ^ sequence +! ! + +!InternalTCPSocket methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence: aTCPSequenceNumber + sequence := aTCPSequenceNumber +! ! + +!InternalTCPSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +state + ^ state +! ! + +!InternalTCPSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +state: aTCPState + Transcript cr; show: self printString, ' -> ', aTCPState name. + aTCPState socket: self. + state := aTCPState +! ! + +!InternalTCPSocket methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:25'! +ttl + ^ 64 +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +updateSendingWindowSize: aPacket + sendingWindowSize := aPacket windowSize. + sender updatedSendingWindowSize +! ! + +!InternalTCPSocket methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +usableWindow + "Answer the 'usable window', i.e. the range of sequence numbers for bytes + that may be sent for the first time. The usable window is always contained + in the offered window." + ^ sequence + 1 to: lastAcknowledged + sendingWindowSize +! ! + +!InternalTCPSocket methodsFor: 'timer' stamp: 'KenD 28/Jun/2026 13:32:25'! +wait2MSL + "(Re)schedule a delete event for 2MSL from now." + self scheduleDetachAfter: self maximumSegmentLifetime * 2 +! ! + +!InternalTCPSocket methodsFor: 'waiting' stamp: 'KenD 28/Jun/2026 13:32:25'! +waitForReadabilityTimeoutAfter: timeoutInMilliseconds + "Wait for readable data, or until timeoutInMilliseconds pass, whichever comes first. -1 is special case wait for ever, also some callers pass zero" + + reassembler waitForReadabilityTimeoutAfter: timeoutInMilliseconds +! ! + +!InternalTCPSocket methodsFor: 'waiting' stamp: 'KenD 28/Jun/2026 13:32:25'! +waitForWritabilityTimeoutAfter: timeoutInMilliseconds + sender waitForWritabilityTimeoutAfter: timeoutInMilliseconds +! ! + +!InternalTCPSocket methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:25'! +windowSize + ^ windowSize +! ! + +!InternalTCPSocket methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:25'! +windowSize: anInteger + self notYetImplemented +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InternalTCPSocket class' category: 'SqueakNOS-Net-Protocols-TCP'! +InternalTCPSocket class + instanceVariableNames: ''! + + +InternalTCPSocket initialize! + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPCloseWait.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPCloseWait.Class.st new file mode 100644 index 00000000..39cc4c1c --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPCloseWait.Class.st @@ -0,0 +1,35 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPCloseWait category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPCloseWait + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPCloseWait commentStamp: '' prior: 0! + +CLOSE-WAIT - represents waiting for a connection termination request from the local user. +! + +!TCPCloseWait methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + self sendFin. + self moveTo: TCPLastACK new +! ! + +!TCPCloseWait methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + aPacket rst ifTrue: [^ self abort: ConnectionReset]. + aPacket syn ifTrue: [^ self reset: aPacket; abort: ConnectionReset]. + + self handleAck: aPacket. + self updateSendingWindowSize: aPacket +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPCloseWait class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPCloseWait class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPClosed.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPClosed.Class.st new file mode 100644 index 00000000..d4be4057 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPClosed.Class.st @@ -0,0 +1,36 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPClosed category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPClosed + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPClosed commentStamp: '' prior: 0! + +CLOSED - represents no connection state at all. +! + +!TCPClosed methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +connect + self sendSyn. + self moveTo: TCPSynSent new +! ! + +!TCPClosed methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + socket reset: aPacket +! ! + +!TCPClosed methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +listen + self moveTo: TCPListen new +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPClosed class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPClosed class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPClosing.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPClosing.Class.st new file mode 100644 index 00000000..9de97833 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPClosing.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPClosing category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPClosing + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPClosing commentStamp: '' prior: 0! + +CLOSING - represents waiting for a connection termination request acknowledgment from the remote TCP. +! + +!TCPClosing methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + aPacket rst ifTrue: [^ socket detach]. + aPacket syn ifTrue: [^ socket reset: aPacket; detach]. + + self handleAck: aPacket. + aPacket fin ifTrue: [^ self]. + self moveTo: TCPTimeWait new. + self wait2MSL +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPClosing class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPClosing class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPEstablished.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPEstablished.Class.st new file mode 100644 index 00000000..2b291833 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPEstablished.Class.st @@ -0,0 +1,37 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPEstablished category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPEstablished + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPEstablished commentStamp: '' prior: 0! + +ESTABLISHED - represents an open connection, data received can be delivered to the user. The normal state for the data transfer phase of the connection. +! + +!TCPEstablished methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + self sendFin. + self moveTo: TCPFinWait1 new +! ! + +!TCPEstablished methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + aPacket rst ifTrue: [^ self abort: ConnectionReset]. + aPacket syn ifTrue: [^ self reset: aPacket; abort: ConnectionReset]. + + self handleAck: aPacket. + self handleData: aPacket. + self updateSendingWindowSize: aPacket. + self reassembler finished ifTrue: [self moveTo: TCPCloseWait new] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPEstablished class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPEstablished class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPFinWait1.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPFinWait1.Class.st new file mode 100644 index 00000000..97a64c6a --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPFinWait1.Class.st @@ -0,0 +1,40 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPFinWait1 category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPFinWait1 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPFinWait1 commentStamp: '' prior: 0! + +FIN-WAIT-1 - represents waiting for a connection termination request from the remote TCP, or an acknowledgment of the connection termination request previously sent. +! + +!TCPFinWait1 methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + self flag: #todo. + aPacket rst ifTrue: [^ self abort: ConnectionReset]. + aPacket syn ifTrue: [^ self reset: aPacket; abort: ConnectionReset]. + + self handleAck: aPacket. + self handleData: aPacket. + self updateSendingWindowSize: aPacket. + self reassembler finished + ifTrue: [socket finAcknowledged + ifTrue: [self moveTo: TCPTimeWait new. + "*** wake closer ***" + self wait2MSL] + ifFalse: [self moveTo: TCPClosing new]] + ifFalse: [socket finAcknowledged + ifTrue: ["*** wake closer ***" + self moveTo: TCPFinWait2 new]] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPFinWait1 class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPFinWait1 class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPFinWait2.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPFinWait2.Class.st new file mode 100644 index 00000000..1bf5b807 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPFinWait2.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPFinWait2 category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPFinWait2 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPFinWait2 commentStamp: '' prior: 0! + +FIN-WAIT-2 - represents waiting for a connection termination request from the remote TCP. +! + +!TCPFinWait2 methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + aPacket rst ifTrue: [^ self abort: ConnectionReset]. + aPacket syn ifTrue: [^ self reset: aPacket; abort: ConnectionReset]. + + self handleAck: aPacket. + self handleData: aPacket. + self reassembler finished ifTrue: [self moveTo: TCPTimeWait new] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPFinWait2 class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPFinWait2 class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPIdle.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPIdle.Class.st new file mode 100644 index 00000000..d1b23e55 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPIdle.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPIdle category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +TCPOutputState subclass: #TCPIdle + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPIdle class' category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +TCPIdle class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPLastACK.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPLastACK.Class.st new file mode 100644 index 00000000..18bea4b7 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPLastACK.Class.st @@ -0,0 +1,34 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPLastACK category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPLastACK + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPLastACK commentStamp: '' prior: 0! + +LAST-ACK - represents waiting for an acknowledgment of the connection termination request previously sent to the remote TCP (which includes an acknowledgment of its connection termination request). +! + +!TCPLastACK methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + aPacket rst ifTrue: [^ self abort: ConnectionReset]. + aPacket syn ifTrue: [^ self reset: aPacket; abort: ConnectionReset]. + + self handleAck: aPacket. + + self flag: #todo. + + socket finAcknowledged + ifTrue: [self moveTo: TCPClosed new. + socket detach] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPLastACK class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPLastACK class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPListen.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPListen.Class.st new file mode 100644 index 00000000..c871dbc6 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPListen.Class.st @@ -0,0 +1,44 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPListen category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPListen + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPListen commentStamp: '' prior: 0! + +LISTEN - represents waiting for a connection request from any remote TCP and port. +! + +!TCPListen methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + self moveTo: TCPClosed new +! ! + +!TCPListen methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +connect + self sendSyn. + self moveTo: TCPSynSent new +! ! + +!TCPListen methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + self flag: #todo. + aPacket rst ifTrue: [^ self]. + (aPacket ack or: [aPacket syn]) ifFalse: [socket reset: aPacket. ^ self]. + aPacket syn ifFalse: [^ self]. + socket remotePort isNil ifTrue: [socket remotePort: aPacket source]. + socket remoteAddress isNil ifTrue: [socket remoteAddress: aPacket envelope source]. + self handleSyn: aPacket. + self sendSynAck. + self moveTo: TCPSynReceived new +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPListen class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPListen class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPOutputState.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPOutputState.Class.st new file mode 100644 index 00000000..5eb30df4 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPOutputState.Class.st @@ -0,0 +1,59 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPOutputState category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +Object subclass: #TCPOutputState + instanceVariableNames: 'socket' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +!TCPOutputState methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +ackArrived + ^ self +! ! + +!TCPOutputState methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +handleAck: aPacket + | prev | + aPacket ack ifFalse: [^ self]. + prev := socket lastAcknowledged. + socket acknowledged: aPacket ackSequence. + prev = socket lastAcknowledged ifFalse: [self ackArrived] +! ! + +!TCPOutputState methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +moveTo: aTCPOutputState + socket sender: aTCPOutputState +! ! + +!TCPOutputState methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + ^ self class name allButFirst: 3 +! ! + +!TCPOutputState methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +retransmit + ^ self +! ! + +!TCPOutputState methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +socket: aTCPSocket + socket := aTCPSocket +! ! + +!TCPOutputState methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +updatedSendingWindowSize + socket sendingWindowSize = 0 ifTrue: [self moveTo: TCPPersist new] +! ! + +!TCPOutputState methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +waitForWritabilityTimeoutAfter: timeoutInMilliseconds + ^ self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPOutputState class' category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +TCPOutputState class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPPersist.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPPersist.Class.st new file mode 100644 index 00000000..86620277 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPPersist.Class.st @@ -0,0 +1,34 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPPersist category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +TCPOutputState subclass: #TCPPersist + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +!TCPPersist methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendWindowProbe + ^ self +! ! + +!TCPPersist methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +updatedSendingWindowSize + socket usableWindow size > 0 ifTrue: [self moveTo: TCPTransmit new] +! ! + +!TCPPersist methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +waitForWritabilityTimeoutAfter: timeoutInMilliseconds + | semaphore | + semaphore := Semaphore new. + self when: #transition send: #signal to: semaphore. + semaphore waitTimeoutMSecs: timeoutInMilliseconds. + socket sendingWindowSize > 0 ifFalse: [TimedOut new signal] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPPersist class' category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +TCPPersist class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPRetransmit.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPRetransmit.Class.st new file mode 100644 index 00000000..44afc94e --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPRetransmit.Class.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPRetransmit category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +TCPOutputState subclass: #TCPRetransmit + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +!TCPRetransmit methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +ackArrived + self moveTo: TCPTransmit new +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPRetransmit class' category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +TCPRetransmit class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPState.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPState.Class.st new file mode 100644 index 00000000..0b78b8ba --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPState.Class.st @@ -0,0 +1,108 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPState category: 'SqueakNOS-Net-Protocols-TCP-States'! +Object subclass: #TCPState + instanceVariableNames: 'socket' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPState methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +abort: anError + "Abort the connection with anError." + socket lastError: anError; detach +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +handleAck: aPacket + socket sender handleAck: aPacket +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +handleData: aPacket + | previousLastSequence | + previousLastSequence := self reassembler lastSequence. + self reassembler add: aPacket. + self reassembler lastSequence > previousLastSequence + ifTrue: [self sendAck] +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +handleSyn: aPacket + self reassembler sequence: aPacket nextSequence. + socket mss: (socket mss min: (aPacket mss ifNil: [536])). + self updateSendingWindowSize: aPacket "is this right ???" +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + self subclassResponsibility +! ! + +!TCPState methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +moveTo: aTCPState + socket state: aTCPState +! ! + +!TCPState methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +name + ^ self class name allButFirst: 3 +! ! + +!TCPState methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +reassembler + ^ socket reassembler +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +reset: aPacket + socket reset: aPacket +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendAck + socket sendAck +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendAckImmediatly + socket sendAckImmediatly +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendFin + socket sendFin +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendSyn + socket sendSyn +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +sendSynAck + socket sendSynAck +! ! + +!TCPState methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +socket: aTCPSocket + socket := aTCPSocket +! ! + +!TCPState methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +updateSendingWindowSize: aPacket + socket updateSendingWindowSize: aPacket +! ! + +!TCPState methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +wait2MSL + "(Re)schedule a delete event for 2MSL from now." + socket wait2MSL +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPState class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPSynReceived.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPSynReceived.Class.st new file mode 100644 index 00000000..7d617d67 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPSynReceived.Class.st @@ -0,0 +1,37 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPSynReceived category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPSynReceived + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPSynReceived commentStamp: '' prior: 0! + +SYN-RECEIVED - represents waiting for a confirming connection request acknowledgment after having both received and sent a connection request. +! + +!TCPSynReceived methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + self sendFin. + self moveTo: TCPFinWait1 new +! ! + +!TCPSynReceived methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + aPacket rst ifTrue: [^ self abort: ConnectionReset]. "or just detach if it was a passive open" + aPacket syn ifTrue: [^ self reset: aPacket; abort: ConnectionReset]. + + self handleAck: aPacket. + self moveTo: TCPEstablished new. + self handleData: aPacket. + self reassembler finished ifTrue: [self moveTo: TCPCloseWait new] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPSynReceived class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPSynReceived class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPSynSent.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPSynSent.Class.st new file mode 100644 index 00000000..7da152fd --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPSynSent.Class.st @@ -0,0 +1,43 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPSynSent category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPSynSent + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPSynSent commentStamp: '' prior: 0! + +SYN-SENT - represents waiting for a matching connection request after having sent a connection request. +! + +!TCPSynSent methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + self reset. + self moveTo: TCPClosed new +! ! + +!TCPSynSent methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket +" (aPacket ack and: [(aPacket ackSequence between: self iss and: self snext) not]) + ifTrue: [^ self reset: aPacket]." + aPacket rst ifTrue: [self moveTo: TCPClosed new. "ConnectionReset, killtimers ... etc"]. + aPacket syn ifFalse: [^ self]. + "socket windowSize: " + self handleAck: aPacket. + self handleSyn: aPacket. + self handleData: aPacket. + aPacket ack + ifTrue: [self sendAckImmediatly. + self moveTo: TCPEstablished new] + ifFalse: [self sendSynAck. + self moveTo: TCPSynReceived new] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPSynSent class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPSynSent class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPTimeWait.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPTimeWait.Class.st new file mode 100644 index 00000000..0a6aa1ad --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPTimeWait.Class.st @@ -0,0 +1,29 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPTimeWait category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPState subclass: #TCPTimeWait + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States'! +!TCPTimeWait commentStamp: '' prior: 0! + +TIME-WAIT - represents waiting for enough time to pass to be sure the remote TCP received the acknowledgment of its connection termination request. +! + +!TCPTimeWait methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + aPacket rst ifTrue: [^ socket detach]. + aPacket syn ifTrue: [^ socket reset: aPacket; detach]. + self handleAck: aPacket. + self handleData: aPacket. + self wait2MSL +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPTimeWait class' category: 'SqueakNOS-Net-Protocols-TCP-States'! +TCPTimeWait class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/States/TCPTransmit.Class.st b/modules/NOS/Network/Protocols/TCP/States/TCPTransmit.Class.st new file mode 100644 index 00000000..cfbb7a09 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/States/TCPTransmit.Class.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPTransmit category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +TCPOutputState subclass: #TCPTransmit + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +!TCPTransmit methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +ackArrived + socket rescheduleRetransmitTimer +! ! + +!TCPTransmit methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +retransmit + self moveTo: TCPRetransmit new +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPTransmit class' category: 'SqueakNOS-Net-Protocols-TCP-States-Output'! +TCPTransmit class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/TCP.Class.st b/modules/NOS/Network/Protocols/TCP/TCP.Class.st new file mode 100644 index 00000000..07b0493b --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/TCP.Class.st @@ -0,0 +1,76 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCP category: 'SqueakNOS-Net-Protocols-TCP'! +Conduit subclass: #TCP + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP'! +!TCP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ aPacket isKindOf: TCPPacket +! ! + +!TCP methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +connectTo: remoteAddress port: remotePort + ^ NetStream on: (self socketTo: remoteAddress port: remotePort) connect +! ! + +!TCP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aTCPPacket + aTCPPacket verifiesChecksum ifFalse: [^ self]. + aTCPPacket envelope source isUnicast ifFalse: [^ self]. + super input: aTCPPacket +! ! + +!TCP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +ip + ^ self left +! ! + +!TCP methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +listenAt: localPort + ^ NetStream on: (self socketAt: localPort) listen +! ! + +!TCP methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +socketAt: localPort + ^ self | (InternalTCPSocket new localPort: localPort) +! ! + +!TCP methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +socketTo: remoteAddress port: remotePort + | localPort | + localPort := (0 to: 65535) atRandom. self flag: #hack. + ^ self socketTo: remoteAddress port: remotePort localPort: localPort +! ! + +!TCP methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +socketTo: remoteAddress port: remotePort localPort: localPort + ^ self | (InternalTCPSocket new localPort: localPort; remoteAddress: remoteAddress; remotePort: remotePort) +! ! + +!TCP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +undeliverable: aPacket + | tcp ip | + aPacket syn ifFalse: [^ self]. + tcp := (TCPPacket new: 0) + source: aPacket destination; + destination: aPacket source; + rst: true; + ack: true; + sequence: 0; + ackSequence: aPacket sequence + 1. + ip := (IPPacket with: tcp) + source: aPacket envelope destination; + destination: aPacket envelope source. + self << ip +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCP class' category: 'SqueakNOS-Net-Protocols-TCP'! +TCP class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/TCPChannel.Class.st b/modules/NOS/Network/Protocols/TCP/TCPChannel.Class.st new file mode 100644 index 00000000..b856022a --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/TCPChannel.Class.st @@ -0,0 +1,40 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPChannel category: 'SqueakNOS-Net-Protocols-TCP'! +Conduit subclass: #TCPChannel + instanceVariableNames: 'localPort remotePort state reassembler' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP'! +!TCPChannel methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ ((aPacket isKindOf: TCPPacket) + and: [localPort isNil or: [aPacket destination = localPort]]) + and: [remotePort isNil or: [aPacket source = remotePort]] +! ! + +!TCPChannel methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + state input: aPacket +! ! + +!TCPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: anInteger from: aByteArray startingAt: startIndex + "Write the next anInteger elements in aByteArray, starting at startIndex. Answer the number of bytes actually written." + + | tcp | + (tcp := TCPPacket new: anInteger) + source: localPort; + destination: remotePort. + tcp replaceFrom: tcp headerSize + 1 to: tcp size with: aByteArray asByteArray startingAt: startIndex. + self << tcp. + ^ anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPChannel class' category: 'SqueakNOS-Net-Protocols-TCP'! +TCPChannel class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/TCP/TCPReassembler.Class.st b/modules/NOS/Network/Protocols/TCP/TCPReassembler.Class.st new file mode 100644 index 00000000..ac2026c8 --- /dev/null +++ b/modules/NOS/Network/Protocols/TCP/TCPReassembler.Class.st @@ -0,0 +1,158 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPReassembler category: 'SqueakNOS-Net-Protocols-TCP'! +Object subclass: #TCPReassembler + instanceVariableNames: 'sequence segments stream finSequence' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-TCP'! +!TCPReassembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +add: aPacket + aPacket lastSequence <= self lastSequence ifTrue: [Transcript cr; show: 'RETRANSMISSION: ', aPacket printString, ' (reassembler seq: ', sequence printString, ')'. ^ aPacket]. "ignore retransmissions" + segments add: aPacket. + self flag: #todo. "handle urgent data" + self triggerEvent: #dataArrived. + ^ aPacket +! ! + +!TCPReassembler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +dataAvailable + self update. + ^ stream atEnd not +! ! + +!TCPReassembler methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:32:25'! +do: aBlock + | index | + segments isEmpty ifTrue: [^ self]. + index := sequence. + segments do: [ :each | + each lastSequence < index "ignore retransmissions" + ifFalse: [(index between: each sequence and: each lastSequence) + ifFalse: [^ self]. + aBlock value: each. + index := each nextSequence]] +! ! + +!TCPReassembler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +finished + "Answer true if a FIN and all data before it has been received." + finSequence notNil ifTrue: [^ true]. + self update. + finSequence notNil ifTrue: [^ true]. + self do: [ :each | each fin ifTrue: [^ true]]. + ^ false +! ! + +!TCPReassembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + sequence := TCPSequenceNumber value: 0. + segments := SortedCollection sortBlock: [ :a :b | a sequence <= b sequence]. + stream := ByteArray new readStream +! ! + +!TCPReassembler methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +isConnected + ^ true +! ! + +!TCPReassembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +lastSequence + | answer | + answer := sequence - 1. + self do: [ :each | answer := answer max: each lastSequence]. + ^ answer +! ! + +!TCPReassembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +next: anInteger into: aByteArray startingAt: startIndex + "Read the next anInteger bytes into aByteArray, starting at startIndex. Answer the number of bytes actually read." + + self dataAvailable ifFalse: [^ 0]. + ^ (stream next: anInteger into: aByteArray startingAt: startIndex) size - startIndex + 1 +! ! + +!TCPReassembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextAvailable + self dataAvailable ifFalse: [^ ByteArray new]. + ^ stream upToEnd +! ! + +!TCPReassembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextSequence + ^ self lastSequence + 1 +! ! + +!TCPReassembler methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +receiveDataTimeout: seconds into: buffer + ^ self receiveDataTimeout: seconds into: buffer startingAt: 1 +! ! + +!TCPReassembler methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +receiveDataTimeout: seconds into: buffer startingAt: index + self waitForReadabilityTimeoutAfter: seconds * 1000. + ^ self next: buffer size - index + 1 into: buffer startingAt: index +! ! + +!TCPReassembler methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +receiveSomeDataInto: aStringOrByteArray + "Receive data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data." + + ^self receiveSomeDataInto: aStringOrByteArray startingAt: 1 +! ! + +!TCPReassembler methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:32:25'! +receiveSomeDataInto: buffer startingAt: index + "Receive data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data." + + ^ self next: buffer size - index + 1 into: buffer startingAt: index +! ! + +!TCPReassembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +sequence: anInteger + sequence := TCPSequenceNumber value: anInteger +! ! + +!TCPReassembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:25'! +update + | aSegment | + stream atEnd ifFalse: [^ self]. + segments isEmpty ifTrue: [^ self]. + aSegment := segments removeFirst. + (aSegment fin and: [finSequence isNil]) ifTrue: [finSequence := aSegment lastSequence]. + stream := (aSegment rawData + copyFrom: (sequence - aSegment sequence) asInteger + 1 + to: aSegment length) readStream. + sequence := aSegment nextSequence +! ! + +!TCPReassembler methodsFor: 'waiting' stamp: 'KenD 28/Jun/2026 13:32:25'! +waitForReadabilityTimeoutAfter: timeoutInMilliseconds + "Wait for readable data, or until timeoutInMilliseconds pass, whichever comes first. -1 is special case wait for ever, also some callers pass zero" + + | deadLine semaphore remainingMSecs | + remainingMSecs := timeoutInMilliseconds. + deadLine := Time millisecondClockValue + remainingMSecs. + semaphore := Semaphore new. + self when: #dataArrived send: #signal to: semaphore. + [self dataAvailable] + whileFalse: [(timeoutInMilliseconds ~~ -1 and: [(remainingMSecs := deadLine - Time millisecondClockValue) <= 0]) + ifTrue: [^ TimedOut new signal]. + semaphore waitTimeoutMSecs: remainingMSecs]. + self dataAvailable ifFalse: [TimedOut new signal] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPReassembler class' category: 'SqueakNOS-Net-Protocols-TCP'! +TCPReassembler class + instanceVariableNames: ''! + +!TCPReassembler class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^ super new initialize +! ! + + +TCPReassembler initialize! + diff --git a/modules/NOS/Network/Protocols/UDP/InternalUDPSocket.Class.st b/modules/NOS/Network/Protocols/UDP/InternalUDPSocket.Class.st new file mode 100644 index 00000000..5027b74e --- /dev/null +++ b/modules/NOS/Network/Protocols/UDP/InternalUDPSocket.Class.st @@ -0,0 +1,80 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #InternalUDPSocket category: 'SqueakNOS-Net-Protocols-UDP'! +InternalRawSocket subclass: #InternalUDPSocket + instanceVariableNames: 'localPort remotePort remoteAddress' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-UDP'! +!InternalUDPSocket methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ (localPort isNil or: [aPacket destination = localPort]) + and: [(remotePort isNil or: [aPacket source = remotePort]) + and: [remoteAddress isNil or: [aPacket envelope source = remoteAddress]]] +! ! + +!InternalUDPSocket methodsFor: 'control' stamp: 'KenD 28/Jun/2026 13:32:25'! +close + self detach +! ! + +!InternalUDPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +localPort + ^ localPort +! ! + +!InternalUDPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +localPort: anInteger + localPort := anInteger +! ! + +!InternalUDPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: anUDPPacket + | ip | + localPort notNil ifTrue: [anUDPPacket source: localPort]. + remotePort notNil ifTrue: [anUDPPacket destination: remotePort]. + ip := IPPacket with: anUDPPacket. + ip destination: remoteAddress. + self << ip +! ! + +!InternalUDPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: anInteger from: aByteArray startingAt: startIndex + "Write the next anInteger elements in aByteArray, starting at startIndex. Answer the number of bytes actually written." + + | udp | + udp := UDPPacket new: anInteger. + udp length: udp size. + udp replaceFrom: udp headerSize + 1 to: udp size with: aByteArray asByteArray startingAt: startIndex. + udp source: self localPort; destination: self remotePort. + self nextPut: udp. + ^ anInteger +! ! + +!InternalUDPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +remoteAddress + ^ remoteAddress +! ! + +!InternalUDPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +remoteAddress: anInternetAddress + remoteAddress := anInternetAddress +! ! + +!InternalUDPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePort + ^ remotePort +! ! + +!InternalUDPSocket methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +remotePort: anInteger + remotePort := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InternalUDPSocket class' category: 'SqueakNOS-Net-Protocols-UDP'! +InternalUDPSocket class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/UDP/UDP.Class.st b/modules/NOS/Network/Protocols/UDP/UDP.Class.st new file mode 100644 index 00000000..2349f879 --- /dev/null +++ b/modules/NOS/Network/Protocols/UDP/UDP.Class.st @@ -0,0 +1,72 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #UDP category: 'SqueakNOS-Net-Protocols-UDP'! +Conduit subclass: #UDP + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-UDP'! +!UDP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ aPacket isKindOf: UDPPacket +! ! + +!UDP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +handleDestinationUnreachable: anICMPPacket + Transcript cr; show: 'destination unreachable: ', anICMPPacket printString +! ! + +!UDP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: anUDPPacket + anUDPPacket verifiesChecksum ifFalse: [^ self]. + anUDPPacket envelope source isUnicast ifFalse: [^ self]. + super input: anUDPPacket +! ! + +!UDP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +ip + ^ self left +! ! + +!UDP methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +left: anIP + super left: anIP. + anIP icmp when: #destinationUnreachable: send: #handleDestinationUnreachable: to: self +! ! + +!UDP methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +socketAt: localPort + ^ self | (InternalUDPSocket new localPort: localPort) +! ! + +!UDP methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +socketTo: remoteAddress port: remotePort + | localPort | + localPort := (0 to: 65535) atRandom. self flag: #hack. + ^ self | (InternalUDPSocket new localPort: localPort; remoteAddress: remoteAddress; remotePort: remotePort) +! ! + +!UDP methodsFor: 'protocol' stamp: 'KenD 28/Jun/2026 13:32:25'! +socketTo: remoteAddress port: remotePort localPort: localPort + ^ self | (InternalUDPSocket new localPort: localPort; remoteAddress: remoteAddress; remotePort: remotePort) +! ! + +!UDP methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +undeliverable: aPacket + | icmp ip | + icmp := (ICMPPacket quote: aPacket envelope) + typeName: #DestinationUnreachable; + codeName: #PortUnreachable. + ip := (IPPacket with: icmp) + source: aPacket envelope destination; + destination: aPacket envelope source. + self << ip +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'UDP class' category: 'SqueakNOS-Net-Protocols-UDP'! +UDP class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Protocols/UDP/UDPChannel.Class.st b/modules/NOS/Network/Protocols/UDP/UDPChannel.Class.st new file mode 100644 index 00000000..ff634e2d --- /dev/null +++ b/modules/NOS/Network/Protocols/UDP/UDPChannel.Class.st @@ -0,0 +1,27 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #UDPChannel category: 'SqueakNOS-Net-Protocols-UDP'! +Conduit subclass: #UDPChannel + instanceVariableNames: 'localPort remotePort' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Protocols-UDP'! +!UDPChannel methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +accepts: aPacket + ^ ((aPacket isKindOf: UDPPacket) + and: [localPort isNil or: [aPacket destination = localPort]]) + and: [remotePort isNil or: [aPacket source = remotePort]] +! ! + +!UDPChannel methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mtu + ^ super mtu - UDPPacket headerSize +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'UDPChannel class' category: 'SqueakNOS-Net-Protocols-UDP'! +UDPChannel class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Support/BitArray.Class.st b/modules/NOS/Network/Support/BitArray.Class.st new file mode 100644 index 00000000..6b9bcd6c --- /dev/null +++ b/modules/NOS/Network/Support/BitArray.Class.st @@ -0,0 +1,124 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #BitArray category: 'SqueakNOS-Net-Support'! +ArrayedCollection subclass: #BitArray + instanceVariableNames: 'contents bitSize' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Support'! +!BitArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +asByteArray + ^ ((1 to: self byteSize) collect: [ :each | self atByte: each]) asByteArray +! ! + +!BitArray methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +asInteger + ^ contents +! ! + +!BitArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger + ^ (contents bitShift: 1-anInteger) bitAnd: 1 +! ! + +!BitArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger put: bit + contents := contents bitOr: (bit bitShift: anInteger-1). + ^ bit +! ! + +!BitArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +atByte: anInteger + ^ (contents bitShift: 1-anInteger*8) bitAnd: 16rFF +! ! + +!BitArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +atByte: anInteger put: byte + contents := contents bitOr: (byte bitShift: anInteger-1*8). + ^ byte +! ! + +!BitArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bitSize + ^ bitSize +! ! + +!BitArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteSize + ^ self bitSize - 1 // 8 + 1 +! ! + +!BitArray methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: anInteger + contents := anInteger +! ! + +!BitArray methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hex + | stream | + stream := WriteStream with: '16r'. + self asByteArray do: [ :each | + stream + nextPut: ('0123456789ABCDEF' at: each // 16 + 1); + nextPut: ('0123456789ABCDEF' at: each \\ 16 + 1)]. + ^ stream contents + + +! ! + +!BitArray methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize: anInteger + bitSize := anInteger. + contents := 0 +! ! + +!BitArray methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ self bitSize +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BitArray class' category: 'SqueakNOS-Net-Support'! +BitArray class + instanceVariableNames: ''! + +!BitArray class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +byte: anInteger + ^ self new: 8 with: anInteger +! ! + +!BitArray class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray + | integer | + integer := 0. + aByteArray reverseDo: [ :each | integer _ integer * 256 + each]. + ^ self new: aByteArray size * 8 with: integer +! ! + +!BitArray class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +double: anInteger + ^ self new: 32 with: anInteger +! ! + +!BitArray class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new: anInteger + ^ self basicNew initialize: anInteger +! ! + +!BitArray class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +new: bitSize with: bits + ^ (self new: bitSize) contents: bits +! ! + +!BitArray class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +quad: anInteger + ^ self new: 64 with: anInteger +! ! + +!BitArray class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +word: anInteger + ^ self new: 16 with: anInteger +! ! + + diff --git a/modules/NOS/Network/Support/CircularBuffer.Class.st b/modules/NOS/Network/Support/CircularBuffer.Class.st new file mode 100644 index 00000000..350b7420 --- /dev/null +++ b/modules/NOS/Network/Support/CircularBuffer.Class.st @@ -0,0 +1,89 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #CircularBuffer category: 'SqueakNOS-Net-Support'! +SequenceableCollection subclass: #CircularBuffer + instanceVariableNames: 'buffer head tally' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Support'! +!CircularBuffer methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:32:25'! +add: anObject + tally < buffer size ifFalse: [^ self errorOutOfBounds]. + buffer at: head + tally - 1 \\ buffer size + 1 put: anObject. + tally := tally + 1. + ^ anObject +! ! + +!CircularBuffer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger + (anInteger > 0 and: [anInteger <= tally]) ifFalse: [^ self errorOutOfBounds]. + ^ buffer at: head + anInteger - 2 \\ buffer size + 1 +! ! + +!CircularBuffer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +capacity + ^ buffer size - self size +! ! + +!CircularBuffer methodsFor: 'initialize-release' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize: capacity + buffer := ByteArray new: capacity. + head := 1. + tally := 0 +! ! + +!CircularBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +next + | answer | + tally > 0 ifFalse: [^ self errorOutOfBounds]. + answer := self first. + tally := tally - 1. + head := head \\ buffer size + 1. + ^ answer +! ! + +!CircularBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: anObject + tally < buffer size ifFalse: [^ self errorOutOfBounds]. + buffer at: head + tally - 1 \\ buffer size + 1 put: anObject. + tally := tally + 1. + ^ anObject +! ! + +!CircularBuffer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPutAll: aCollection + aCollection do: [ :each | self nextPut: each] +! ! + +!CircularBuffer methodsFor: 'removing' stamp: 'KenD 28/Jun/2026 13:32:25'! +removeFirst + | answer | + tally > 0 ifFalse: [^ self errorOutOfBounds]. + answer := self first. + tally := tally - 1. + head := head \\ buffer size + 1. + ^ answer +! ! + +!CircularBuffer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ tally +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CircularBuffer class' category: 'SqueakNOS-Net-Support'! +CircularBuffer class + instanceVariableNames: ''! + +!CircularBuffer class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^ self new: 512 +! ! + +!CircularBuffer class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +new: anInteger + ^ super new initialize: anInteger +! ! + + diff --git a/modules/NOS/Network/Support/InternetAddress.Class.st b/modules/NOS/Network/Support/InternetAddress.Class.st new file mode 100644 index 00000000..135fb7ef --- /dev/null +++ b/modules/NOS/Network/Support/InternetAddress.Class.st @@ -0,0 +1,107 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #InternetAddress category: 'SqueakNOS-Net-Support'! +NetAddress subclass: #InternetAddress + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Support'! +!InternetAddress methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +group + ^ self isMulticast ifTrue: [((BitArray bytes: bytes) copyFrom: 5 to: 5+28-1) asInteger] +! ! + +!InternetAddress methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +host + | bits | + bits := BitArray bytes: bytes. + self isClassA ifTrue: [^ (bits copyFrom: 9 to: 32) asInteger]. + self isClassB ifTrue: [^ (bits copyFrom: 17 to: 32) asInteger]. + self isClassC ifTrue: [^ (bits copyFrom: 25 to: 32) asInteger]. + ^ nil +! ! + +!InternetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isAny + ^ bytes allSatisfy: [ :each | each = 0] +! ! + +!InternetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isBroadcast + ^ bytes allSatisfy: [ :each | each = 255] +! ! + +!InternetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isClassA + ^ bytes first between: 0 and: 127 +! ! + +!InternetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isClassB + ^ bytes first between: 128 and: 191 +! ! + +!InternetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isClassC + ^ bytes first between: 192 and: 223 +! ! + +!InternetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isClassD + ^ bytes first between: 224 and: 239 +! ! + +!InternetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isClassE + ^ bytes first between: 240 and: 247 +! ! + +!InternetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isMulticast + ^ bytes first between: 224 and: 239 +! ! + +!InternetAddress methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +isUnicast + ^ bytes first between: 0 and: 223 +! ! + +!InternetAddress methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +net + | bits | + bits := BitArray bytes: bytes. + self isClassA ifTrue: [^ (bits copyFrom: 2 to: 2+7-1) reversed asInteger]. + self isClassB ifTrue: [^ (bits copyFrom: 3 to: 3+14-1) reversed asInteger]. + self isClassC ifTrue: [^ (bits copyFrom: 4 to: 4+21-1) reversed asInteger]. + ^ nil +! ! + +!InternetAddress methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + self bytes + do: [ :each | aStream nextPutAll: each asString] + separatedBy: [aStream nextPut: $.] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InternetAddress class' category: 'SqueakNOS-Net-Support'! +InternetAddress class + instanceVariableNames: ''! + +!InternetAddress class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +fromString: aString + "Return the internet address represented by the given string. The string should contain four positive decimal integers delimited by periods, commas, or spaces, where each integer represents one address byte. Return nil if the string is not a host address in an acceptable format." + "self fromString: '1.2.3.4'" + "self fromString: '1,2,3,4'" + "self fromString: '1 2 3 4'" + + ^ self bytes: ((aString findTokens: '., ') collect: [ :each | each asInteger]) +! ! + +!InternetAddress class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ 16r800 +! ! + + diff --git a/modules/NOS/Network/Support/NetAddress.Class.st b/modules/NOS/Network/Support/NetAddress.Class.st new file mode 100644 index 00000000..6fe27764 --- /dev/null +++ b/modules/NOS/Network/Support/NetAddress.Class.st @@ -0,0 +1,99 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NetAddress category: 'SqueakNOS-Net-Support'! +ArrayedCollection subclass: #NetAddress + instanceVariableNames: 'bytes' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Support'! +!NetAddress methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:32:25'! +& aNetAddress + | newBytes | + newBytes := ByteArray new: bytes size. + 1 to: bytes size do: [ :each | newBytes at: each put: ((bytes at: each) bitAnd: (aNetAddress bytes at: each))]. + ^ self class bytes: newBytes +! ! + +!NetAddress methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +/ anInteger + ^ NetBlock new address: self; mask: (self class bytes: (BitArray new: self size * 8 with: (1 bitShift: anInteger) - 1) asByteArray) +! ! + +!NetAddress methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:32:25'! += aNetAddress + ^ self class = aNetAddress class and: [bytes = aNetAddress bytes] +! ! + +!NetAddress methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +asByteArray + ^ bytes +! ! + +!NetAddress methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger + ^ bytes at: anInteger +! ! + +!NetAddress methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger put: byte + ^ self shouldNotImplement +! ! + +!NetAddress methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes + ^ bytes +! ! + +!NetAddress methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray + bytes := aByteArray asByteArray +! ! + +!NetAddress methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hash + ^ bytes hash +! ! + +!NetAddress methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:32:25'! +not + ^ self class bytes: (bytes collect: [ :each | each bitInvert]) +! ! + +!NetAddress methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ bytes size +! ! + +!NetAddress methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:32:25'! +xor: aNetAddress + | newBytes | + newBytes := ByteArray new: bytes size. + 1 to: bytes size do: [ :each | newBytes at: each put: ((bytes at: each) bitXor: (aNetAddress bytes at: each))]. + ^ self class bytes: newBytes +! ! + +!NetAddress methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:32:25'! +| aNetAddress + | newBytes | + newBytes := ByteArray new: bytes size. + 1 to: bytes size do: [ :each | newBytes at: each put: ((bytes at: each) bitOr: (aNetAddress bytes at: each))]. + ^ self class bytes: newBytes +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NetAddress class' category: 'SqueakNOS-Net-Support'! +NetAddress class + instanceVariableNames: ''! + +!NetAddress class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray + ^ self new bytes: aByteArray +! ! + +!NetAddress class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +type + ^ nil +! ! + + diff --git a/modules/NOS/Network/Support/NetBlock.Class.st b/modules/NOS/Network/Support/NetBlock.Class.st new file mode 100644 index 00000000..4a146642 --- /dev/null +++ b/modules/NOS/Network/Support/NetBlock.Class.st @@ -0,0 +1,73 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NetBlock category: 'SqueakNOS-Net-Support'! +ArrayedCollection subclass: #NetBlock + instanceVariableNames: 'address mask' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Support'! +!NetBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address + ^ address +! ! + +!NetBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +address: aNetAddress + address := aNetAddress +! ! + +!NetBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger + | bits orBits newBit | + bits := anInteger. + orBits := (BitArray bytes: mask bytes reversed) + collect: [ :each | + each = 0 + ifTrue: [newBit := bits bitAnd: 1. bits := bits bitShift: -1. newBit] + ifFalse: [0]]. + ^ address & mask | (NetAddress bytes: orBits asByteArray reversed) +! ! + +!NetBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +broadcast + ^ self at: self size - 1 +! ! + +!NetBlock methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +includes: aNetAddress + ^ aNetAddress & mask = address +! ! + +!NetBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mask + ^ mask +! ! + +!NetBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +mask: aNetAddress + mask := aNetAddress +! ! + +!NetBlock methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + | bits index | + aStream print: address. + bits := BitArray bytes: mask bytes. + index := bits findLast: [ :one | one = 1]. + index + 1 = (bits findFirst: [ :one | one = 0]) + ifTrue: [aStream nextPut: $/; print: index] + ifFalse: [aStream space; print: mask] +! ! + +!NetBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ 2 raisedTo: ((BitArray bytes: mask bytes) occurrencesOf: 0) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NetBlock class' category: 'SqueakNOS-Net-Support'! +NetBlock class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Support/NetStream.Class.st b/modules/NOS/Network/Support/NetStream.Class.st new file mode 100644 index 00000000..7ab57b85 --- /dev/null +++ b/modules/NOS/Network/Support/NetStream.Class.st @@ -0,0 +1,31 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NetStream category: 'SqueakNOS-Net-Support'! +SocketStream subclass: #NetStream + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Support'! +!NetStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +dataAvailable + ^ self isDataAvailable +! ! + +!NetStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +next: anInteger timeoutAfter: msecs + self timeout: msecs // 1000. + ^self next: anInteger +! ! + +!NetStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +waitForReadabilityTimeoutAfter: timeoutInMilliseconds + ^ socket waitForReadabilityTimeoutAfter: timeoutInMilliseconds +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NetStream class' category: 'SqueakNOS-Net-Support'! +NetStream class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Support/TCPSequenceNumber.Class.st b/modules/NOS/Network/Support/TCPSequenceNumber.Class.st new file mode 100644 index 00000000..947617e2 --- /dev/null +++ b/modules/NOS/Network/Support/TCPSequenceNumber.Class.st @@ -0,0 +1,65 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPSequenceNumber category: 'SqueakNOS-Net-Support'! +Magnitude subclass: #TCPSequenceNumber + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Support'! +!TCPSequenceNumber methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:32:25'! ++ anInteger + ^ self class value: value + anInteger asInteger \\ 16r100000000 +! ! + +!TCPSequenceNumber methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:32:25'! +- anInteger + ^ self class value: value - anInteger asInteger \\ 16r100000000 +! ! + +!TCPSequenceNumber methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:32:25'! +< aNumber + ^ value ~= aNumber asInteger and: [aNumber asInteger - value \\ 16r100000000 < 16r80000000] +! ! + +!TCPSequenceNumber methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:32:25'! += aNumber + ^ value = aNumber asInteger +! ! + +!TCPSequenceNumber methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +adaptToInteger: rcvr andSend: selector + ^ self class value: (rcvr perform: selector with: value) \\ 16r100000000 +! ! + +!TCPSequenceNumber methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +asInteger + ^ value +! ! + +!TCPSequenceNumber methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:32:25'! +hash + ^ value hash +! ! + +!TCPSequenceNumber methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:32:25'! +printOn: aStream + aStream nextPut: $[; print: self asInteger; nextPut: $] +! ! + +!TCPSequenceNumber methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +setValue: anInteger + value := anInteger asInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPSequenceNumber class' category: 'SqueakNOS-Net-Support'! +TCPSequenceNumber class + instanceVariableNames: ''! + +!TCPSequenceNumber class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +value: anInteger + ^ self new setValue: anInteger +! ! + + diff --git a/modules/NOS/Network/Tests/IPFragmentsTest.Class.st b/modules/NOS/Network/Tests/IPFragmentsTest.Class.st new file mode 100644 index 00000000..b25d6dff --- /dev/null +++ b/modules/NOS/Network/Tests/IPFragmentsTest.Class.st @@ -0,0 +1,65 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPFragmentsTest category: 'SqueakNOS-Net-Tests'! +TestCase subclass: #IPFragmentsTest + instanceVariableNames: 'packet fragments' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!IPFragmentsTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +fragmentSize + ^ 300 +! ! + +!IPFragmentsTest methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +setUp + packet := IPPacket with: (UDPPacket new: 1000). + packet + source: (InternetAddress fromString: '1.2.3.4'); + destination: (InternetAddress fromString: '5.6.7.8'). + packet setChecksum. + fragments := packet fragmentsSized: self fragmentSize +! ! + +!IPFragmentsTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testFragmentsLength + self assert: (fragments allSatisfy: [ :each | each length <= self fragmentSize]). + self assert: (fragments collect: [ :each | each length - each headerSize]) sum = (packet length - packet headerSize) +! ! + +!IPFragmentsTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testMF + self assert: (fragments allButLast allSatisfy: [ :each | each mf]). + self assert: fragments last mf not +! ! + +!IPFragmentsTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testReassembly + | defragmented reassemblyList | + reassemblyList := IPReassemblyList new. + fragments shuffled do: [ :each | reassemblyList add: each]. + self assert: reassemblyList isComplete. + defragmented := reassemblyList packet. + defragmented setChecksum. + self assert: defragmented length = packet length. + self assert: defragmented asByteArray = packet asByteArray +! ! + +!IPFragmentsTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testReassemblyCompletion + | shuffledFragments reassemblyList | + reassemblyList := IPReassemblyList new. + shuffledFragments := fragments shuffled. + shuffledFragments allButLast do: [ :each | reassemblyList add: each]. + self assert: reassemblyList isComplete not. + reassemblyList add: shuffledFragments last. + self assert: reassemblyList isComplete +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPFragmentsTest class' category: 'SqueakNOS-Net-Tests'! +IPFragmentsTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Tests/IPOptionsTest.Class.st b/modules/NOS/Network/Tests/IPOptionsTest.Class.st new file mode 100644 index 00000000..93a6ba6c --- /dev/null +++ b/modules/NOS/Network/Tests/IPOptionsTest.Class.st @@ -0,0 +1,42 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPOptionsTest category: 'SqueakNOS-Net-Tests'! +TestCase subclass: #IPOptionsTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!IPOptionsTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testClassification + | option | + option := IPOption bytes: #(68 3 1). "timestamp" + self assert: option classification = 2. + self assert: option number = 4. + self assert: option length = 3 +! ! + +!IPOptionsTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testEOL + | option | + option := IPOption bytes: #(0). + self assert: option classification = 0. + self assert: option number = 0. + self assert: option isEOL +! ! + +!IPOptionsTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testNop + | option | + option := IPOption bytes: #(1). + self assert: option classification = 0. + self assert: option number = 1. + self assert: option isNOP +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPOptionsTest class' category: 'SqueakNOS-Net-Tests'! +IPOptionsTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Tests/IPTest.Class.st b/modules/NOS/Network/Tests/IPTest.Class.st new file mode 100644 index 00000000..56af2214 --- /dev/null +++ b/modules/NOS/Network/Tests/IPTest.Class.st @@ -0,0 +1,131 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #IPTest category: 'SqueakNOS-Net-Tests'! +TestCase subclass: #IPTest + instanceVariableNames: 'loopback ip1 ip2' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!IPTest methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:32:25'! +newHostWithAddress: anInternetAddress + | ip | + ip := IP new. + ip address: anInternetAddress. + ip | ICMP new. + ip | TCP new. + ip | UDP new. + ^ ip +! ! + +!IPTest methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:32:25'! +roundTripMilliseconds + ^ 1000 +! ! + +!IPTest methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:32:25'! +setUp + ip1 := self newHostWithAddress: (InternetAddress fromString: '192.168.88.1'). + ip2 := self newHostWithAddress: (InternetAddress fromString: '192.168.88.2'). + + loopback := NetInterface loopback. + + loopback | PluggableConduit transcripter | ip1. + loopback | PluggableConduit transcripter | ip2. + + loopback up +! ! + +!IPTest methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:32:25'! +tearDown + loopback down +! ! + +!IPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testBigIPPacket + | received bigPacket socket | + socket := ip2 raw | InternalRawSocket new. + bigPacket := (IPPacket with: (UDPPacket new: 5000)) destination: ip2 address. + ip1 << bigPacket. + received := [socket nextTimeoutMSecs: self roundTripMilliseconds] on: TimedOut do: []. + self assert: received notNil. + self assert: received length = bigPacket length +! ! + +!IPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testIPPacket + | semaphore received | + semaphore := Semaphore new. + ip2 | (PluggableConduit new incomingAction: [ :packet | received _ packet. semaphore signal]). + ip1 << ((IPPacket with: (UDPPacket new: 100)) destination: ip2 address). + semaphore waitTimeoutMSecs: self roundTripMilliseconds. + self assert: received notNil +! ! + +!IPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testPing + | icmp ip socket response | + icmp := (ICMPPacket new: 100) + typeName: #EchoRequest; + id: 1; + sequence: 1. + ip := (IPPacket with: icmp) + destination: ip2 address; + ttl: 255; + id: 34233. + socket := ip1 icmp | InternalRawSocket new. + socket nextPut: ip. + response := [socket nextTimeoutMSecs: 1000] on: TimedOut do: [self error: 'timed out']. + self assert: response isEchoReply & (response envelope source = ip2 address) +! ! + +!IPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testProtocolUnreachable + | received socket | + socket := ip1 icmp | InternalRawSocket new. + ip1 << ((IPPacket with: (IGMPPacket new: 100)) destination: ip2 address). + received := [socket nextTimeoutMSecs: self roundTripMilliseconds] on: TimedOut do: []. + self assert: received notNil. + self assert: received isProtocolUnreachable +! ! + +!IPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testRawIP + | received socket | + socket := ip2 raw | InternalRawSocket new. + ip1 << ((IPPacket with: (UDPPacket new: 100)) destination: ip2 address). + received := [socket nextTimeoutMSecs: self roundTripMilliseconds] on: TimedOut do: []. + self assert: received notNil. + self assert: received destination = ip2 address. + self assert: received source = ip1 address. + self assert: (received data isKindOf: UDPPacket) +! ! + +!IPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testUDP + | socket1 socket2 hola | + socket1 := ip1 udp socketTo: ip2 address port: 5678 localPort: 1234. + socket2 := ip2 udp socketTo: ip1 address port: 1234 localPort: 5678. + self assert: socket2 dataAvailable not. + socket1 nextPut: (UDPPacket with: 'hola'). + hola := socket2 nextTimeoutMSecs: self roundTripMilliseconds. + self assert: hola rawData asString = 'hola'. + self assert: socket2 dataAvailable not +! ! + +!IPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testUDPClosed + | received socket | + socket := ip1 icmp | InternalRawSocket new. + ip1 << ((IPPacket with: ((UDPPacket new: 100) destination: 100)) destination: ip2 address). + received := [socket nextTimeoutMSecs: self roundTripMilliseconds] on: TimedOut do: []. + self assert: received notNil. + self assert: received isPortUnreachable +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'IPTest class' category: 'SqueakNOS-Net-Tests'! +IPTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Tests/NetHighLevelTest.Class.st b/modules/NOS/Network/Tests/NetHighLevelTest.Class.st new file mode 100644 index 00000000..02edc5c9 --- /dev/null +++ b/modules/NOS/Network/Tests/NetHighLevelTest.Class.st @@ -0,0 +1,91 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NetHighLevelTest category: 'SqueakNOS-Net-Tests'! +TestCase subclass: #NetHighLevelTest + instanceVariableNames: 'loopback net1 net2' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!NetHighLevelTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +newHostWithEthernet: anEthernetAddress ip: anInternetAddress + | ip ethernet | + ip := IP new. + ip address: anInternetAddress. + ip | ICMP new. + ip | TCP new. + ip | UDP new. + ethernet := Ethernet new. + ethernet address: anEthernetAddress. + ethernet | ip. + ethernet arp protocolAddress: ip address. + ^ ethernet +! ! + +!NetHighLevelTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +roundTripMilliseconds + ^ 100 +! ! + +!NetHighLevelTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +setUp + net1 := self newHostWithEthernet: (EthernetAddress fromString: '00:48:54:85:CC:51') ip: (InternetAddress fromString: '192.168.88.1'). + net2 := self newHostWithEthernet: (EthernetAddress fromString: '00:82:44:55:DD:67') ip: (InternetAddress fromString: '192.168.88.2'). + + loopback := NetInterface loopback. + + loopback "| TranscripterConduit new" | net1. + loopback "| TranscripterConduit new" | net2. + + loopback up +! ! + +!NetHighLevelTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +tearDown + loopback down +! ! + +!NetHighLevelTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testNetDown + loopback down. + self value: [(net1 findA: IP) << ((IPPacket with: (UDPPacket new: 100)) destination: (net2 findA: IP) address)] shouldRaise: NetDown +! ! + +!NetHighLevelTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testPing + | ping | + ping := Ping new. + (net1 findA: ICMP) | ping. + self assert: (ping ping: (net2 findA: IP) address). + self assert: (ping ping: (net1 findA: IP) address). + self deny: (ping ping: (InternetAddress fromString: '192.168.88.123')) +! ! + +!NetHighLevelTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testTCPSynScanner + | scanner ports | + scanner := TCPSynScanner new. + scanner destination: (net2 findA: IP) address. + (net1 findA: IP) | scanner. + ports := (1 to: 10) collect: [ :each | 65535 atRandom]. + scanner scanAll: ports. + (Delay forMilliseconds: self roundTripMilliseconds) wait. + ports do: [ :each | self assert: (scanner closed includes: each)]. + self assert: scanner open isEmpty +! ! + +!NetHighLevelTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testTraceRoute + | traceroute route | + traceroute := TraceRoute new. + (net1 findA: IP) | traceroute. + route := traceroute routeTo: (net2 findA: IP) address. + self assert: route size = 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NetHighLevelTest class' category: 'SqueakNOS-Net-Tests'! +NetHighLevelTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Tests/PacketInspector.Class.st b/modules/NOS/Network/Tests/PacketInspector.Class.st new file mode 100644 index 00000000..d9862e6a --- /dev/null +++ b/modules/NOS/Network/Tests/PacketInspector.Class.st @@ -0,0 +1,44 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #PacketInspector category: 'SqueakNOS-Net-Tests'! +Object subclass: #PacketInspector + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!PacketInspector methodsFor: 'selecting' stamp: 'KenD 28/Jun/2026 13:32:25'! +contentsIsString + "Hacked so contents empty when deselected and = long printString when item 2" + + ^ false +! ! + +!PacketInspector methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fieldList + ^ object class allFieldsNames +! ! + +!PacketInspector methodsFor: 'selecting' stamp: 'KenD 28/Jun/2026 13:32:25'! +replaceSelectionValue: anObject + "Add colon to fieldname to get setter selector, and send it to object with the argument. + Refer to the comment in Inspector|replaceSelectionValue:." + + selectionIndex = 1 + ifTrue: [^object] + ifFalse: [^object perform: ((self fieldList at: selectionIndex), ':') asSymbol with: anObject] +! ! + +!PacketInspector methodsFor: 'selecting' stamp: 'KenD 28/Jun/2026 13:32:25'! +selection + "Refer to the comment in Inspector|selection." + selectionIndex <= 1 ifTrue: [^object]. + ^ object perform: (self fieldList at: selectionIndex) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PacketInspector class' category: 'SqueakNOS-Net-Tests'! +PacketInspector class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Tests/PluggableConduit.Class.st b/modules/NOS/Network/Tests/PluggableConduit.Class.st new file mode 100644 index 00000000..f70fdd97 --- /dev/null +++ b/modules/NOS/Network/Tests/PluggableConduit.Class.st @@ -0,0 +1,45 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #PluggableConduit category: 'SqueakNOS-Net-Tests'! +Conduit subclass: #PluggableConduit + instanceVariableNames: 'incomingAction outgoingAction' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!PluggableConduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +incomingAction: aBlock + incomingAction := aBlock +! ! + +!PluggableConduit methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + incomingAction ifNotNil: [incomingAction value: aPacket]. + super input: aPacket +! ! + +!PluggableConduit methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +outgoingAction: aBlock + outgoingAction := aBlock +! ! + +!PluggableConduit methodsFor: 'flow' stamp: 'KenD 28/Jun/2026 13:32:25'! +output: aPacket + outgoingAction ifNotNil: [outgoingAction value: aPacket]. + super output: aPacket +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PluggableConduit class' category: 'SqueakNOS-Net-Tests'! +PluggableConduit class + instanceVariableNames: ''! + +!PluggableConduit class methodsFor: 'examples' stamp: 'KenD 28/Jun/2026 13:32:25'! +transcripter + ^ self new + outgoingAction: [ :aPacket | Transcript cr; show: '<< '; show: aPacket fullPrintString]; + incomingAction: [ :aPacket | Transcript cr; show: '>> '; show: aPacket fullPrintString]; + yourself +! ! + + diff --git a/modules/NOS/Network/Tests/RealisticLoopback.Class.st b/modules/NOS/Network/Tests/RealisticLoopback.Class.st new file mode 100644 index 00000000..a25625bf --- /dev/null +++ b/modules/NOS/Network/Tests/RealisticLoopback.Class.st @@ -0,0 +1,102 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #RealisticLoopback category: 'SqueakNOS-Net-Tests'! +Object subclass: #RealisticLoopback + instanceVariableNames: 'process queue random dropRate corruptionRate unsortRate maxDelay minDelay minimumSize' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +corruptedCopyOf: aPacket + | corrupted | + corruptionRate <= 0 ifTrue: [^ aPacket]. + corrupted := aPacket copy. + 1 to: corrupted size do: [ :each | + random next < corruptionRate + ifTrue: [corrupted at: each put: (random next * 256) truncated]]. + ^ corrupted +! ! + +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +corruptionRate: aNumber + corruptionRate := aNumber +! ! + +!RealisticLoopback methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:32:25'! +down + process ifNotNil: [process terminate]. + process := nil +! ! + +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +dropRate: aNumber + dropRate := aNumber +! ! + +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + super initialize. + queue := SharedQueue new. + random := Random new. + dropRate := 0.0. + corruptionRate := 0.0. + unsortRate := 0.0. + minDelay := 50. + maxDelay := 100. + minimumSize := 60 "pad small packets to 60 bytes" +! ! + +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +input: aPacket + random next < dropRate ifTrue: [^ self]. + random next < unsortRate ifTrue: [^ self output: aPacket]. "re-enqueue it" + aPacket size < minimumSize ifTrue: [aPacket class bytes: (aPacket asByteArray, (ByteArray new: minimumSize - aPacket size))]. "pad to minimum size" + (Delay forMilliseconds: (minDelay to: maxDelay) atRandom) wait. + super input: (self corruptedCopyOf: aPacket) +! ! + +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +loop + self input: queue next +! ! + +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +maxDelay: msecs + maxDelay := msecs +! ! + +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +minDelay: msecs + minDelay := msecs +! ! + +!RealisticLoopback methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +minimumSize: anInteger + minimumSize := anInteger +! ! + +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +output: aPacket + queue nextPut: aPacket +! ! + +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsortRate: aNumber + unsortRate := aNumber +! ! + +!RealisticLoopback methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +up + self down. + process := [[self loop] repeat] fork +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RealisticLoopback class' category: 'SqueakNOS-Net-Tests'! +RealisticLoopback class + instanceVariableNames: ''! + + +RealisticLoopback initialize! + diff --git a/modules/NOS/Network/Tests/SqueakNOSNetworkTest.Class.st b/modules/NOS/Network/Tests/SqueakNOSNetworkTest.Class.st new file mode 100644 index 00000000..123e54f6 --- /dev/null +++ b/modules/NOS/Network/Tests/SqueakNOSNetworkTest.Class.st @@ -0,0 +1,127 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #SqueakNOSNetworkTest category: 'SqueakNOS-Net-Tests'! +TestCase subclass: #SqueakNOSNetworkTest + instanceVariableNames: 'eth' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +addressOfTestServer + ^ InternetAddress fromString: '192.168.88.64' +! ! + +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +localAddress + ^ InternetAddress fromString: '192.168.88.66' +! ! + +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +setUp + eth := EthernetInterface on: Computer current defaultNetworkDevice. + eth internetAddress: self localAddress. + eth up +! ! + +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +tearDown + eth down +! ! + +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testPing + | icmp ip socket response | + icmp := (ICMPPacket new: 100) + typeName: #EchoRequest; + id: 1; + sequence: 1. + ip := (IPPacket with: icmp) + destination: self addressOfTestServer; + ttl: 255; + id: 34233. + socket := eth ip icmp | InternalRawSocket new. + socket nextPut: ip. + response := [socket nextTimeoutMSecs: 1000] on: TimedOut do: [self error: 'timed out']. + self assert: response isEchoReply & (response envelope source = self addressOfTestServer) +! ! + +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testPingBig + | icmp ip socket response | + icmp := (ICMPPacket new: 10000) + typeName: #EchoRequest; + id: 1; + sequence: 1. + ip := (IPPacket with: icmp) + destination: self addressOfTestServer; + ttl: 255; + id: 34233. + socket := eth ip icmp | InternalRawSocket new. + socket nextPut: ip. + response := [socket nextTimeoutMSecs: 1000] on: TimedOut do: [self error: 'timed out']. + self assert: response isEchoReply & (response envelope source = self addressOfTestServer) +! ! + +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testProtocolUnreachable + | received socket | + socket := eth ip icmp | InternalRawSocket new. + eth ip << ((IPPacket with: (IGMPPacket new: 100)) destination: self addressOfTestServer). + received := [socket nextTimeoutMSecs: self roundTripMilliseconds] on: TimedOut do: []. + self assert: received notNil. + self assert: received isProtocolUnreachable +! ! + +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testTCPEcho + | stream | + stream := eth ip tcp connectTo: self addressOfTestServer port: 7. + stream nextPutAll: 'hola'; flush. + [stream waitForReadabilityTimeoutAfter: 1000] on: TimedOut do: [^ self error: 'timed out']. + self assert: stream nextAvailable = 'hola'. + stream close +! ! + +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testTCPEcho2 + | stream | + stream := eth ip tcp connectTo: self addressOfTestServer port: 7. + self assert: stream dataAvailable not. + stream nextPutAll: 'hola'; flush. + [stream waitForReadabilityTimeoutAfter: 1000] on: TimedOut do: [^ self error: 'timed out']. + self assert: stream nextAvailable = 'hola'. + self assert: stream dataAvailable not. + stream nextPutAll: 'chau'; flush. + [stream waitForReadabilityTimeoutAfter: 1000] on: TimedOut do: [^ self error: 'timed out']. + self assert: stream nextAvailable = 'chau'. + self assert: stream dataAvailable not. + stream close +! ! + +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testUDPClosed + | received socket | + socket := eth ip icmp | InternalRawSocket new. + eth ip << ((IPPacket with: ((UDPPacket new: 100) destination: 100)) destination: self addressOfTestServer). + received := [socket nextTimeoutMSecs: self roundTripMilliseconds] on: TimedOut do: []. + self assert: received notNil. + self assert: received isPortUnreachable +! ! + +!SqueakNOSNetworkTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testUDPEcho + | socket packet | + socket := eth ip udp socketTo: self addressOfTestServer port: 7. + socket nextPut: (UDPPacket with: 'hola'). + [packet := socket nextTimeoutMSecs: 1000] on: TimedOut do: [^ self error: 'timed out']. + self assert: packet rawData asString = 'hola'. + socket close +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SqueakNOSNetworkTest class' category: 'SqueakNOS-Net-Tests'! +SqueakNOSNetworkTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Tests/TCPPacketTest.Class.st b/modules/NOS/Network/Tests/TCPPacketTest.Class.st new file mode 100644 index 00000000..e74e30a5 --- /dev/null +++ b/modules/NOS/Network/Tests/TCPPacketTest.Class.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPPacketTest category: 'SqueakNOS-Net-Tests'! +TestCase subclass: #TCPPacketTest + instanceVariableNames: 'packet' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!TCPPacketTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +setUp + packet _ TCPPacket bytes: #(129 12 0 21 46 10 150 13 0 0 0 0 160 2 22 208 48 22 0 0 2 4 5 180 4 2 8 10 0 27 234 226 0 0 0 0 1 3 3 0) asByteArray +! ! + +!TCPPacketTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testOptions + | mss timestamp windowScale | + self assert: packet options size = 5. + mss := packet options first. + self assert: mss value = 1460. + timestamp := packet options third. + self assert: timestamp value = 1829602. + self assert: timestamp echo = 0. + windowScale := packet options last. + self assert: windowScale factor = 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPPacketTest class' category: 'SqueakNOS-Net-Tests'! +TCPPacketTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Tests/TCPReassemblerTest.Class.st b/modules/NOS/Network/Tests/TCPReassemblerTest.Class.st new file mode 100644 index 00000000..2b9a7320 --- /dev/null +++ b/modules/NOS/Network/Tests/TCPReassemblerTest.Class.st @@ -0,0 +1,118 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPReassemblerTest category: 'SqueakNOS-Net-Tests'! +TestCase subclass: #TCPReassemblerTest + instanceVariableNames: 'reassembler stream packets' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!TCPReassemblerTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +packetWithData: aString sequence: anInteger + | tcp ip | + tcp _ TCPPacket new: aString size. + tcp sequence: anInteger. + tcp replaceFrom: tcp headerSize + 1 to: tcp size with: aString asByteArray startingAt: 1. + ip _ IPPacket with: tcp. + ^ ip data +! ! + +!TCPReassemblerTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +setUp + reassembler := TCPReassembler new. + reassembler sequence: 0. + stream := NetStream on: reassembler +! ! + +!TCPReassemblerTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testDataAfterFin + reassembler add: ((self packetWithData: '01234' sequence: 0) fin: true). + reassembler add: (self packetWithData: '56789' sequence: 5). + self assert: reassembler dataAvailable. + self assert: reassembler finished. + self assert: reassembler nextAvailable asString = '01234'. + self assert: reassembler dataAvailable not +! ! + +!TCPReassemblerTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testFinWithData + reassembler add: (self packetWithData: '01234' sequence: 0). + reassembler add: ((self packetWithData: '56789' sequence: 5) fin: true). + self assert: stream dataAvailable. + self assert: reassembler finished. + self assert: (stream next: 10) asString = '0123456789'. + self assert: stream dataAvailable not +! ! + +!TCPReassemblerTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testLateFin + self assert: reassembler finished not. + reassembler add: ((self packetWithData: '' sequence: 0) syn: true). + self assert: reassembler finished not. + reassembler add: ((self packetWithData: '' sequence: 5) fin: true). + self assert: reassembler finished not. + reassembler add: (self packetWithData: '1234' sequence: 1). + self assert: reassembler finished +! ! + +!TCPReassemblerTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testOverlapingData + reassembler add: (self packetWithData: '012345' sequence: 0). + reassembler add: (self packetWithData: '456789' sequence: 4). + self assert: stream dataAvailable. + self assert: (stream next: 10) asString = '0123456789'. + self assert: stream dataAvailable not +! ! + +!TCPReassemblerTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testReassembly + self assert: reassembler dataAvailable not. + reassembler add: ((self packetWithData: '' sequence: 0) syn: true). + self assert: reassembler dataAvailable not. + reassembler add: (self packetWithData: 'asdf' sequence: 1). + self assert: reassembler dataAvailable. + self assert: reassembler nextAvailable asString = 'asdf'. + self assert: reassembler dataAvailable not +! ! + +!TCPReassemblerTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testReassemblyStream + self assert: stream dataAvailable not. + reassembler add: ((self packetWithData: '' sequence: 0) syn: true). + self assert: stream dataAvailable not. + reassembler add: (self packetWithData: 'asdfg' sequence: 1). + self assert: stream dataAvailable. + self assert: (stream next: 4) asString = 'asdf'. + self assert: stream dataAvailable. + self assert: stream next asCharacter = $g. + self assert: stream dataAvailable not +! ! + +!TCPReassemblerTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testSequenceWrapAround + | seq | + seq := TCPSequenceNumber value: 16rFFFFFFF8. + reassembler sequence: seq. + reassembler add: (self packetWithData: '012345' sequence: seq). + reassembler add: (self packetWithData: '678901' sequence: seq+6). + reassembler add: (self packetWithData: '23456789' sequence: seq+12). + self assert: stream dataAvailable. + self assert: (stream next: 20) asString = '01234567890123456789'. + self assert: stream dataAvailable not +! ! + +!TCPReassemblerTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testUnsortedData + reassembler add: (self packetWithData: '456789' sequence: 4). + reassembler add: (self packetWithData: '012345' sequence: 0). + self assert: stream dataAvailable. + self assert: (stream next: 10) asString = '0123456789'. + self assert: stream dataAvailable not +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPReassemblerTest class' category: 'SqueakNOS-Net-Tests'! +TCPReassemblerTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Tests/TCPSequenceTest.Class.st b/modules/NOS/Network/Tests/TCPSequenceTest.Class.st new file mode 100644 index 00000000..de20b1dc --- /dev/null +++ b/modules/NOS/Network/Tests/TCPSequenceTest.Class.st @@ -0,0 +1,43 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPSequenceTest category: 'SqueakNOS-Net-Tests'! +TestCase subclass: #TCPSequenceTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!TCPSequenceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testArithmetic + self assert: (TCPSequenceNumber value: 16rFFFFFFFF) + 1 = (TCPSequenceNumber value: 0). + self assert: (TCPSequenceNumber value: 0) - 1 = (TCPSequenceNumber value: 16rFFFFFFFF). + self assert: (TCPSequenceNumber value: 0) + 1 = (TCPSequenceNumber value: 1). + self assert: (TCPSequenceNumber value: 1) - 1 = (TCPSequenceNumber value: 0) +! ! + +!TCPSequenceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testComparision + self assert: (TCPSequenceNumber value: 0) < (TCPSequenceNumber value: 1). + self deny: (TCPSequenceNumber value: 1) < (TCPSequenceNumber value: 1). + self deny: (TCPSequenceNumber value: 1) < (TCPSequenceNumber value: 0) +! ! + +!TCPSequenceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testReverseArithmetic + self assert: 1 + (TCPSequenceNumber value: 16rFFFFFFFF) = (TCPSequenceNumber value: 0). + self assert: 1 + (TCPSequenceNumber value: 0) = (TCPSequenceNumber value: 1) +! ! + +!TCPSequenceTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testWrapAround + self assert: (TCPSequenceNumber value: 16rFFFFFFFF) < (TCPSequenceNumber value: 0). + self assert: (TCPSequenceNumber value: 16rFFFFFFF4) < (TCPSequenceNumber value: 4). + self assert: (TCPSequenceNumber value: 16rFFFFFFF1) < (TCPSequenceNumber value: 15) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPSequenceTest class' category: 'SqueakNOS-Net-Tests'! +TCPSequenceTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Network/Tests/TCPTest.Class.st b/modules/NOS/Network/Tests/TCPTest.Class.st new file mode 100644 index 00000000..3819a29f --- /dev/null +++ b/modules/NOS/Network/Tests/TCPTest.Class.st @@ -0,0 +1,286 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #TCPTest category: 'SqueakNOS-Net-Tests'! +TestCase subclass: #TCPTest + instanceVariableNames: 'loopback ip1 ip2 socket1 socket2 stream1 stream2' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Net-Tests'! +!TCPTest methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:32:25'! +newHostWithAddress: anInternetAddress + | ip | + ip := IP new. + ip address: anInternetAddress. + ip | ICMP new. + ip | UDP new. + ip | TCP new. + ^ ip +! ! + +!TCPTest methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:32:25'! +roundTripMilliseconds + ^ 1000 +! ! + +!TCPTest methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:32:25'! +setUp + ip1 := self newHostWithAddress: (InternetAddress fromString: '192.168.88.1'). + ip2 := self newHostWithAddress: (InternetAddress fromString: '192.168.88.2'). + + ip1 tcp timerUp. + ip2 tcp timerUp. + + loopback := NetInterface on: RealisticLoopback new. + + loopback | (PluggableConduit new outgoingAction: [ :each | Transcript cr; nextPutAll: '(1) ', each fullPrintString]) | ip1. + loopback | (PluggableConduit new outgoingAction: [ :each | Transcript cr; nextPutAll: '(2) ', each fullPrintString]) | ip2. + + stream1 := NetStream on: (socket1 := InternalTCPSocket new localPort: 1234; remoteAddress: ip2 address; remotePort: 5678). + stream2 := NetStream on: (socket2 := InternalTCPSocket new localPort: 5678; remoteAddress: ip1 address; remotePort: 1234). + (ip1 findA: TCP) | socket1. + (ip2 findA: TCP) | socket2. + + loopback up +! ! + +!TCPTest methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:32:25'! +tearDown + ip1 tcp timerDown. + ip2 tcp timerDown. + + loopback down +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testConnectionEstablishment + socket1 listen. + self assert: (socket1 state isKindOf: TCPListen). + socket2 connect. + self assert: (socket2 state isKindOf: TCPSynSent). + (Delay forMilliseconds: 2000) wait. + self assert: (socket1 state isKindOf: TCPEstablished). + self assert: (socket2 state isKindOf: TCPEstablished) +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testConnectionRefused +" socket1 listen." "skip listening and still try to connect" + socket2 connect. + self assert: (socket2 state isKindOf: TCPSynSent). + (Delay forMilliseconds: 1000) wait. + self assert: (socket1 state isKindOf: TCPClosed) +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testConnectionTermination + socket1 listen. + self assert: (socket1 state isKindOf: TCPListen). + socket2 connect. + self assert: (socket2 state isKindOf: TCPSynSent). + (Delay forMilliseconds: 1000) wait. + self assert: (socket1 state isKindOf: TCPEstablished). + self assert: (socket2 state isKindOf: TCPEstablished). + socket1 close. + (Delay forMilliseconds: 1000) wait. + self assert: (socket1 state isKindOf: TCPFinWait2). + self assert: (socket2 state isKindOf: TCPCloseWait). + socket2 close. + (Delay forMilliseconds: 1000) wait. + self assert: (socket1 state isKindOf: TCPTimeWait). + self assert: (socket2 state isKindOf: TCPClosed) +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testDataFlow + | data | + socket1 listen. + socket2 connect. + (Delay forMilliseconds: 1000) wait. + self assert: stream2 dataAvailable not. + stream1 nextPutAll: 'hola'; flush. + self shouldnt: [data := stream2 next: 4 timeoutAfter: self roundTripMilliseconds] raise: TimedOut. + self assert: data = 'hola'. + self assert: stream2 dataAvailable not +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testHalfClose + | data | + socket1 listen. + socket2 connect. + (Delay forMilliseconds: 1000) wait. + stream2 close. + (Delay forMilliseconds: 1000) wait. + self assert: stream2 dataAvailable not. + stream1 nextPutAll: 'some data'; flush. + self shouldnt: [data := stream2 next: 9 timeoutAfter: self roundTripMilliseconds] raise: TimedOut. + self assert: data = 'some data'. + self assert: stream2 dataAvailable not +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testKamikaze + "Test sending and receibing a nastigram, i.e. a segment + with SYN, EOL, URG, and FIN on and carrying one octet of data." + self assert: false +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testListenWildcards + socket1 remoteAddress: nil; remotePort: nil. + socket1 listen. + self assert: (socket1 state isKindOf: TCPListen). + socket2 connect. + (Delay forMilliseconds: 1000) wait. + self assert: (socket1 state isKindOf: TCPEstablished). + self assert: (socket2 state isKindOf: TCPEstablished). + self assert: socket1 remoteAddress = ip2 address. + self assert: socket1 remotePort = socket2 localPort +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testRetransmission + | data | + socket1 listen. + socket2 connect. + (Delay forMilliseconds: 1000) wait. + self assert: stream2 dataAvailable not. + loopback device dropRate: 1. + stream1 nextPutAll: 'hola'; flush. + self should: [stream2 next: 4 timeoutAfter: self roundTripMilliseconds] raise: TimedOut. + self assert: stream2 dataAvailable not. + loopback device dropRate: 0. + self shouldnt: [data := stream2 next: 4 timeoutAfter: self roundTripMilliseconds * 2] raise: TimedOut. + self assert: data = 'hola'. + self assert: stream2 dataAvailable not +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testSelfConnect + socket1 remoteAddress: ip1 address; remotePort: socket1 localPort. + socket1 connect. + self assert: (socket1 state isKindOf: TCPSynSent). + (Delay forMilliseconds: 1000) wait. + self assert: (socket1 state isKindOf: TCPEstablished) +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testSelfConnectDataFlow + | data | + socket1 remoteAddress: ip1 address; remotePort: socket1 localPort. + socket1 connect. + self assert: stream1 dataAvailable not. + stream1 nextPutAll: 'hola'; flush. + (Delay forMilliseconds: 1000) wait. + self assert: stream1 dataAvailable. + self shouldnt: [data := stream2 next: 4 timeoutAfter: self roundTripMilliseconds] raise: TimedOut. + self assert: data = 'hola'. + self assert: stream1 dataAvailable not +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testSequenceNumberWraparound + "Test proper functioning when sequence + numbers (a) pass 2**31 (i.e., go from plus to 'minus') and + (b) pass 2**32 (i.e., go from 2**32-1 to 0)." + + | data | + socket1 sequence: (TCPSequenceNumber value: 16rFFFFFFF4). + socket1 listen. + socket2 connect. + (Delay forMilliseconds: 1000) wait. + self assert: stream2 dataAvailable not. + stream1 nextPutAll: '1234567890abcdef'; flush. + self shouldnt: [data := stream2 next: 16 timeoutAfter: self roundTripMilliseconds] raise: TimedOut. + self assert: data = '1234567890abcdef'. + self assert: stream2 dataAvailable not +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testSequenceNumberWraparound2 + | data | + socket1 sequence: (TCPSequenceNumber value: 16rFFFFFFF4). + socket1 listen. + socket2 connect. + (Delay forMilliseconds: 1000) wait. + self assert: stream2 dataAvailable not. + '1234567890abcdef' do: [ :each | stream1 nextPut: each]. + stream1 flush. + self shouldnt: [data := stream2 next: 16 timeoutAfter: self roundTripMilliseconds] raise: TimedOut. + self assert: data = '1234567890abcdef'. + self assert: stream2 dataAvailable not +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testSimultaneousClose + socket1 listen. + self assert: (socket1 state isKindOf: TCPListen). + socket2 connect. + self assert: (socket2 state isKindOf: TCPSynSent). + (Delay forMilliseconds: 1000) wait. + self assert: (socket1 state isKindOf: TCPEstablished). + self assert: (socket2 state isKindOf: TCPEstablished). + socket1 close. + socket2 close. + (Delay forMilliseconds: 1000) wait. + self assert: (socket1 state isKindOf: TCPTimeWait). + self assert: (socket2 state isKindOf: TCPTimeWait) +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testSimultaneousOpen + socket1 connect. + self assert: (socket1 state isKindOf: TCPSynSent). + socket2 connect. + self assert: (socket2 state isKindOf: TCPSynSent). + (Delay forMilliseconds: 1000) wait. + self assert: (socket2 state isKindOf: TCPEstablished). + self assert: (socket1 state isKindOf: TCPEstablished) +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testSlowStart + self assert: false +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testTwoConnectionsDataFlow + | data stream3 socket3 stream4 socket4 data2 | + socket1 listen. + socket2 connect. + stream3 := NetStream on: (socket3 := InternalTCPSocket new localPort: 11234; remoteAddress: ip2 address; remotePort: 15678). + stream4 := NetStream on: (socket4 := InternalTCPSocket new localPort: 15678; remoteAddress: ip1 address; remotePort: 11234). + (ip1 findA: TCP) | socket3. + (ip2 findA: TCP) | socket4. + socket3 listen. + socket4 connect. + + (Delay forMilliseconds: 1000) wait. + self assert: stream2 dataAvailable not. + stream1 nextPutAll: 'hola'; flush. + stream3 nextPutAll: 'hello'; flush. + self shouldnt: [data2 := stream4 next: 5 timeoutAfter: self roundTripMilliseconds] raise: TimedOut. + self shouldnt: [data := stream2 next: 4 timeoutAfter: self roundTripMilliseconds] raise: TimedOut. + self assert: data = 'hola'. + self assert: data2 = 'hello'. + self assert: stream2 dataAvailable not. + self assert: stream4 dataAvailable not +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testUrgentData + self assert: false +! ! + +!TCPTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:32:25'! +testZeroWindowACK + self assert: false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TCPTest class' category: 'SqueakNOS-Net-Tests'! +TCPTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/OFW-OLPC/OFWDeviceNode.Class.st b/modules/NOS/OFW-OLPC/OFWDeviceNode.Class.st new file mode 100644 index 00000000..b314a351 --- /dev/null +++ b/modules/NOS/OFW-OLPC/OFWDeviceNode.Class.st @@ -0,0 +1,82 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #OFWDeviceNode category: 'SqueakNOS-OFW-OLPC'! +OpenFirmwareCalloutClient subclass: #OFWDeviceNode + instanceVariableNames: 'phandle' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-OFW-OLPC'! +!OFWDeviceNode commentStamp: '' prior: 0! + +chosen := OFWDeviceNode findDevice: '/chosen' +chosen nextProp: '' + +! + +!OFWDeviceNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +getProp: propertyName + | args len buf | + len := self getPropLen: propertyName. + buf := String new: len. + args := self newArgsFor: 'getprop' inputs: 4 outputs: 1. + args at: 4 put: phandle. + args at: 5 put: propertyName, (Character value: 0) asString. + args at: 6 put: buf. + args at: 7 put: len. + self callout: args. + ^ buf + +! ! + +!OFWDeviceNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +getPropLen: propertyName + | args | + args := self newArgsFor: 'getproplen' inputs: 2 outputs: 1. + args at: 4 put: phandle. + args at: 5 put: propertyName, (Character value: 0) asString. + self callout: args. + ^ args last + +! ! + +!OFWDeviceNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +handle + ^ phandle +! ! + +!OFWDeviceNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +handle: anInteger + phandle := anInteger +! ! + +!OFWDeviceNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextProp: previous + | args buf | + buf := String new: 32. + args := self newArgsFor: 'getprop' inputs: 3 outputs: 1. + args at: 4 put: phandle. + args at: 5 put: previous, (Character value: 0) asString. + args at: 6 put: buf. + + self callout: args. + ^ buf + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OFWDeviceNode class' category: 'SqueakNOS-OFW-OLPC'! +OFWDeviceNode class + instanceVariableNames: ''! + +!OFWDeviceNode class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +findDevice: nodeName + | args | + args := self newArgsFor: 'finddevice' inputs: 1 outputs: 1. + args at: 4 put: nodeName. + self callout: args. + ^ self new handle: args last + +! ! + + diff --git a/modules/NOS/OFW-OLPC/OpenFirmwareCalloutClient.Class.st b/modules/NOS/OFW-OLPC/OpenFirmwareCalloutClient.Class.st new file mode 100644 index 00000000..10c15ce1 --- /dev/null +++ b/modules/NOS/OFW-OLPC/OpenFirmwareCalloutClient.Class.st @@ -0,0 +1,59 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #OpenFirmwareCalloutClient category: 'SqueakNOS-OFW-OLPC'! +Object subclass: #OpenFirmwareCalloutClient + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-OFW-OLPC'! +!OpenFirmwareCalloutClient commentStamp: '' prior: 0! + +args := OpenFirmwareCalloutClient newArgsFor: 'interpreter' inputs: 1 outputs: 0. +args at: 4 put: '." hola manola"'. +OpenFirmwareCalloutClient callout: args. +(ExternalAddress new fromInteger: args fourth / 2) stringAt: 0 size: 100 + +! + +!OpenFirmwareCalloutClient methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +callout: anArray + self class callout: anArray +! ! + +!OpenFirmwareCalloutClient methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +newArgsFor: serviceName inputs: aInteger outputs: bInteger + ^ self class newArgsFor: serviceName inputs: aInteger outputs: bInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'OpenFirmwareCalloutClient class' category: 'SqueakNOS-OFW-OLPC'! +OpenFirmwareCalloutClient class + instanceVariableNames: ''! + +!OpenFirmwareCalloutClient class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +callout: anArray + | answer | + answer := self primOFWCallout: anArray. + answer = 0 ifFalse: [^ self error: 'OpenFirmware calout returned error: ', answer printString] +! ! + +!OpenFirmwareCalloutClient class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +newArgsFor: serviceName inputs: aInteger outputs: bInteger + | answer | + answer := Array new: 3 + aInteger + bInteger. + answer + at: 1 put: serviceName, (Character value: 0) asString; + at: 2 put: aInteger; + at: 3 put: bInteger. + ^ answer + +! ! + +!OpenFirmwareCalloutClient class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +primOFWCallout: anArray + + ^ self primitiveFailed +! ! + + diff --git a/modules/NOS/Storage/BlockArithmetic.Class.st b/modules/NOS/Storage/BlockArithmetic.Class.st new file mode 100644 index 00000000..0f765964 --- /dev/null +++ b/modules/NOS/Storage/BlockArithmetic.Class.st @@ -0,0 +1,89 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #BlockArithmetic category: 'SqueakNOS-Storage'! +Object subclass: #BlockArithmetic + instanceVariableNames: 'blockSize' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +alignedFrom: first to: last do: aBlock + | nextEnd remaining | + + nextEnd := last min: (self lastPositionInSameBlockOf: first). + aBlock value: first value: nextEnd. + remaining := last - nextEnd. + [remaining > 0] whileTrue: [ | nextStart | + nextStart := nextEnd + 1. + nextEnd := nextEnd + (remaining min: blockSize). + aBlock value: nextStart value: nextEnd. + remaining := remaining - blockSize. + ]. + +! ! + +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +alignedStart: first end: last with: aBlock + aBlock value: (self firstPositionInSameBlockOf: first) value: (self lastPositionInSameBlockOf: last). +! ! + +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockNumberOf: anInteger + ^anInteger - 1 // self blockSize + 1. +! ! + +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockSize + "Answer the value of blockSize" + + ^ blockSize +! ! + +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockSize: anObject + "Set the value of blockSize" + + blockSize := anObject +! ! + +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstPositionInSameBlockOf: position + ^position - (position - 1 \\ blockSize) +! ! + +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +from: first to: last do: aBlock + first to: last by: blockSize do: [ :next | aBlock value: next ]. +! ! + +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +lastPositionInSameBlockOf: position + ^(self firstPositionInSameBlockOf: position) + blockSize - 1. +! ! + +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +positionInBlockOf: position + ^ position - 1 \\ blockSize + 1. +! ! + +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + "Answer the value of blockSize" + + ^ blockSize +! ! + +!BlockArithmetic methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size: anObject + "Set the value of blockSize" + + blockSize := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockArithmetic class' category: 'SqueakNOS-Storage'! +BlockArithmetic class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Storage/BlockArithmetic0.Class.st b/modules/NOS/Storage/BlockArithmetic0.Class.st new file mode 100644 index 00000000..9661ab65 --- /dev/null +++ b/modules/NOS/Storage/BlockArithmetic0.Class.st @@ -0,0 +1,40 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #BlockArithmetic0 category: 'SqueakNOS-Storage'! +BlockArithmetic subclass: #BlockArithmetic0 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!BlockArithmetic0 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockNumberOf: anInteger + ^anInteger // self blockSize. +! ! + +!BlockArithmetic0 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstPositionInSameBlockOf: position + ^position - (position \\ blockSize) +! ! + +!BlockArithmetic0 methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +offsetInBlockOf: position + ^position \\ blockSize +! ! + +!BlockArithmetic0 methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +size: aSize + ^self new size: aSize +! ! + +!BlockArithmetic0 methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +size: aSize index: index + ^self new size: aSize index: index +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockArithmetic0 class' category: 'SqueakNOS-Storage'! +BlockArithmetic0 class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Storage/BlockCache.Class.st b/modules/NOS/Storage/BlockCache.Class.st new file mode 100644 index 00000000..98c90b11 --- /dev/null +++ b/modules/NOS/Storage/BlockCache.Class.st @@ -0,0 +1,191 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #BlockCache category: 'SqueakNOS-Storage'! +Object subclass: #BlockCache + instanceVariableNames: 'device chunks writeList' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockSize + ^device blockSize +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +chunkSize + ^256 +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +chunksFrom: firstBlockOfFirstChunk to: firstBlockOfLastChunk + + ^(firstBlockOfFirstChunk to: firstBlockOfLastChunk by: self chunkSize) collect: [ :firstBlockOfChunk | + chunks at: firstBlockOfChunk ifAbsent: [ | aByteArray | + aByteArray := device from: firstBlockOfChunk to: firstBlockOfChunk + self chunkSize - 1. + chunks at: firstBlockOfChunk put: aByteArray. + self updateChunk: aByteArray withWritesAt: firstBlockOfChunk. + aByteArray + ] + ] + + +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +clear + "Discards all changes" + chunks := Dictionary new. + writeList := WriteList new. +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +concatenationFrom: first to: last of: aCollectionOfChunks + | result offsetInResult chunkFirst helper i | + helper := BlockArithmetic new blockSize: self chunkSize. + i := 1. + result := ByteArray new: last - first + 1 * self blockSize. + offsetInResult := 1. + chunkFirst := first - 1 * self blockSize + 1. + + helper alignedFrom: first to: last do: [ :nextStart :nextEnd | | count | + + count := nextEnd - nextStart + 1 * self blockSize. + result replaceFrom: offsetInResult to: offsetInResult + count - 1 with: (aCollectionOfChunks at: i) startingAt: chunkFirst. + chunkFirst := 1. + i := i + 1. + offsetInResult := offsetInResult + count. + ]. + + ^result + +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +flushWrites + | helper buffer | + self halt. + helper := BlockArithmetic new size: self blockSize. + writeList do: [ :byteStart :byteEnd :segments | + + helper alignedStart: byteStart end: byteEnd with: [ :alignedByteStart :alignedByteEnd | + buffer := ByteArray new: alignedByteEnd - alignedByteStart + 1. + self readHalfWrittenSectorsInto: buffer start: byteStart end: byteEnd. + + segments do: [ :aSegment | + buffer replaceFrom: (aSegment at: 1) - alignedByteStart + 1 + to: (aSegment at: 1) - alignedByteStart + (aSegment at: 2) size + with: (aSegment at: 2) startingAt: 1 + ]. + + device at: (helper blockNumberOf: alignedByteStart) writeArray: buffer. + + ] + ]. + + writeList clear. + + +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +from: firstBlock to: lastBlock + | helper | + helper := BlockArithmetic new size: self chunkSize. + + helper alignedStart: firstBlock end: lastBlock with: [ :firstBlockOfFirstChunk :lastBlockOfLastChunk | | firstBlockOfLastChunk | + firstBlockOfLastChunk := lastBlockOfLastChunk - self chunkSize + 1. + ^self concatenationFrom: firstBlock - firstBlockOfFirstChunk + 1 + to: lastBlock - firstBlockOfFirstChunk + 1 + of: (self chunksFrom: firstBlockOfFirstChunk to: firstBlockOfLastChunk). + ]. + + +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +invalidateFrom: destOffset bytesCount: bytesCount + | helper | + helper := BlockArithmetic new size: self chunkSize * self blockSize. + helper from: (helper blockNumberOf: destOffset) to: (helper blockNumberOf: destOffset + bytesCount - 1) do: [ :chunkStart | + chunks removeKey: chunkStart ifAbsent: []. + ]. +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aBlockDevice + device := aBlockDevice. + chunks := Dictionary new. + writeList := WriteList new. +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +readHalfWrittenSectorsInto: buffer start: byteStart end: byteEnd + + | firstBlock lastBlock blocksCount firstSectorRead helper | + + helper := BlockArithmetic new blockSize: self blockSize. + firstSectorRead := false. + firstBlock := helper blockNumberOf: byteStart. + lastBlock := helper blockNumberOf: byteEnd. + blocksCount := lastBlock - firstBlock + 1. + + "If it starts at block boundaries, we don't need to read the block. We'll probably overwrite it entirely" + (helper positionInBlockOf: byteStart ) ~= 1 ifTrue: [ + firstSectorRead := true. + buffer replaceFrom: 1 to: self blockSize with: (device at: firstBlock) startingAt: 1. + ]. + + "If it ends at block boundaries, we don't need to read the last block. We'll probably overwrite it entirely" + (helper positionInBlockOf: byteEnd) ~= self blockSize ifTrue: [ + (blocksCount = 1 & firstSectorRead) ifFalse: [ + buffer replaceFrom: 1 to: self blockSize with: (device at: lastBlock) startingAt: 1. + ]. + ]. + +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +replaceFromByte: destOffset bytesCount: bytesCount with: source startingAtByte: sourceOffset + "Transcript show: 'Writing from: ', destOffset, ' count: ', bytesCount, ' + '." + writeList at: destOffset wrote: (source copyFrom: sourceOffset to: sourceOffset + bytesCount - 1). + + self updateChunksFrom: destOffset bytesCount: bytesCount with: source startingAtByte: sourceOffset. + +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +updateChunk: aChunk withWritesAt: firstBlockOfChunk + writeList writeFrom: firstBlockOfChunk - 1 * self blockSize + 1 + to: firstBlockOfChunk + self chunkSize - 1 * self blockSize + into: aChunk. + + +! ! + +!BlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +updateChunksFrom: destOffset bytesCount: bytesCount with: source startingAtByte: sourceOffset + | helper sourceStart | + helper := BlockArithmetic new size: self chunkSize * self blockSize. + sourceStart := sourceOffset. + + helper alignedFrom: destOffset to: destOffset + bytesCount - 1 do: [ :nextStart :nextEnd | + chunks at: (helper firstPositionInSameBlockOf: nextStart) - 1 // self blockSize + 1 ifPresent: [ :aByteArray | + aByteArray replaceFrom: (helper positionInBlockOf: nextStart) to: (helper positionInBlockOf: nextEnd) with: source startingAt: sourceStart. + sourceStart := sourceStart + self blockSize. + ]. + ]. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockCache class' category: 'SqueakNOS-Storage'! +BlockCache class + instanceVariableNames: ''! + +!BlockCache class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aBlockDevice + ^self new on: aBlockDevice. +! ! + + diff --git a/modules/NOS/Storage/BlockCacheTest.Class.st b/modules/NOS/Storage/BlockCacheTest.Class.st new file mode 100644 index 00000000..32ba7c8c --- /dev/null +++ b/modules/NOS/Storage/BlockCacheTest.Class.st @@ -0,0 +1,60 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #BlockCacheTest category: 'SqueakNOS-Storage-Tests'! +TestCase subclass: #BlockCacheTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage-Tests'! +!BlockCacheTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testBigWrite + | device cache array original | + device := Computer blankBlockDeviceForTest. + cache := BlockCache on: device. + + device at: 1 writeArray: (ByteArray new: 300000). + array := ByteArray new: 200000. + 1 to: 200000 do: [ :i | array at: i put: i \\ 256 ]. + original := (device from: 2 to: 300000) asByteArray. + + original replaceFrom: 15 to: 200009 with: array startingAt: 5. + cache replaceFromByte: (15 + cache blockSize) bytesCount: 199995 with: array startingAtByte: 5. + + self assert: original = (cache from: 2 to: 300000). + +! ! + +!BlockCacheTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testRead + | device cache | + device := ATAController primary master. + cache := BlockCache on: device. + + + self assert: (device from: 10 to: 11) asByteArray = (cache from: 10 to: 11). + self assert: (device from: 1 to: 1) asByteArray = (cache from: 1 to: 1). + self assert: (device from: 100 to: 110) asByteArray = (cache from: 100 to: 110). +! ! + +!BlockCacheTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testWrite + | device cache array original | + device := ATAController primary master. + cache := BlockCache on: device. + + array := ByteArray withAll: (0 to: 255). + + original := (device at: 1) asByteArray. + original replaceFrom: 15 to: 32 with: array startingAt: 5. + cache replaceFromByte: 15 bytesCount: 18 with: array startingAtByte: 5. + + self assert: original = (cache from: 1 to: 1). +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockCacheTest class' category: 'SqueakNOS-Storage-Tests'! +BlockCacheTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Storage/BlockDeviceOnStream.Class.st b/modules/NOS/Storage/BlockDeviceOnStream.Class.st new file mode 100644 index 00000000..0576e947 --- /dev/null +++ b/modules/NOS/Storage/BlockDeviceOnStream.Class.st @@ -0,0 +1,73 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #BlockDeviceOnStream category: 'SqueakNOS-Storage'! +BlockDevice subclass: #BlockDeviceOnStream + instanceVariableNames: 'stream blockSize' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!BlockDeviceOnStream commentStamp: '' prior: 0! + +I provide objects that allow to see files as block devices. It's similar to loop devices in linux. +! + +!BlockDeviceOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: aBlockNumber + "Retrieve sector number aBlockNumber from device" + + stream position: (aBlockNumber - 1) * self blockSize. + ^ stream next: self blockSize +! ! + +!BlockDeviceOnStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: aBlockNumber count: blocksCount + "Retrieve sector number aBlockNumber from device" + + stream position: (aBlockNumber - 1 * self blockSize). + ^stream next: self blockSize * blocksCount. +! ! + +!BlockDeviceOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: firstBlockNumber writeArray: aByteArray + "Write aByteArray to disk starting at firstBlockNumber. aByteArray size should be multiple of the sector size" + + stream position: (firstBlockNumber - 1) * self blockSize. + stream nextPutAll: aByteArray +! ! + +!BlockDeviceOnStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockSize + ^blockSize. +! ! + +!BlockDeviceOnStream methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +from: firstBlockNumber to: lastBlockNumber + "Retrieve sectorst from firstBlockNumber to lastBlockNumber" + + ^self at: firstBlockNumber count: lastBlockNumber - firstBlockNumber + 1. +! ! + +!BlockDeviceOnStream methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aStream blockSize: aBlockSize + stream := aStream. + stream binary. + blockSize := aBlockSize. +! ! + +!BlockDeviceOnStream methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^stream size / self blockSize +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockDeviceOnStream class' category: 'SqueakNOS-Storage'! +BlockDeviceOnStream class + instanceVariableNames: ''! + +!BlockDeviceOnStream class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aStream blockSize: anInteger + ^self new on: aStream blockSize: anInteger +! ! + + diff --git a/modules/NOS/Storage/BlockDeviceSegment.Class.st b/modules/NOS/Storage/BlockDeviceSegment.Class.st new file mode 100644 index 00000000..45dc7687 --- /dev/null +++ b/modules/NOS/Storage/BlockDeviceSegment.Class.st @@ -0,0 +1,79 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #BlockDeviceSegment category: 'SqueakNOS-Storage'! +BlockDevice subclass: #BlockDeviceSegment + instanceVariableNames: 'device offset size' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!BlockDeviceSegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: index + ^device at: index + offset +! ! + +!BlockDeviceSegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: firstBlockNumber writeArray: aByteArray + ^device at: firstBlockNumber + offset writeArray: aByteArray +! ! + +!BlockDeviceSegment methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockSize + ^ device blockSize +! ! + +!BlockDeviceSegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +from: start to: stop + ^device from: start + offset to: stop + offset +! ! + +!BlockDeviceSegment methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aBlockStorage from: start to: stop + device := aBlockStorage. + offset := start - 1. + size := stop - start + 1 . size >= 0 + ifFalse: [ self halt ] +! ! + +!BlockDeviceSegment methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^size +! ! + +!BlockDeviceSegment methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +sizeInBytes + ^size * device blockSize +! ! + +!BlockDeviceSegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAt: byteIndex + ^ device unsignedLongAt: byteIndex + (offset * self blockSize) +! ! + +!BlockDeviceSegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAt: byteIndex put: value + ^ device unsignedLongAt: byteIndex + (offset * self blockSize) put: value +! ! + +!BlockDeviceSegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAt: byteIndex + ^ device unsignedShortAt: byteIndex + (offset * self blockSize) +! ! + +!BlockDeviceSegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAt: byteIndex put: value + ^ device unsignedShortAt: byteIndex + (offset * self blockSize) put: value +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockDeviceSegment class' category: 'SqueakNOS-Storage'! +BlockDeviceSegment class + instanceVariableNames: ''! + +!BlockDeviceSegment class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aBlockStorage from: start to: stop + ^self new on: aBlockStorage from: start to: stop + +! ! + + diff --git a/modules/NOS/Storage/ByteArrayOnBlockDevice.Class.st b/modules/NOS/Storage/ByteArrayOnBlockDevice.Class.st new file mode 100644 index 00000000..aaa0d8d7 --- /dev/null +++ b/modules/NOS/Storage/ByteArrayOnBlockDevice.Class.st @@ -0,0 +1,121 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ByteArrayOnBlockDevice category: 'SqueakNOS-Storage'! +ArrayedCollection subclass: #ByteArrayOnBlockDevice + instanceVariableNames: 'contents' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!ByteArrayOnBlockDevice commentStamp: '' prior: 0! + +I look like a byte array, but map operations to an underlying block device. + +People talk to me as if I were a byte array, but under the hood I transform operations to block device operations (remember that block devices have a 512 byte granularity). +! + +!ByteArrayOnBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger + ^self byteAt: anInteger +! ! + +!ByteArrayOnBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger put: byte + ^self byteAt: anInteger put: byte +! ! + +!ByteArrayOnBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteAt: index + ^contents byteAt: index +! ! + +!ByteArrayOnBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteAt: index put: value + ^contents byteAt: index put: value +! ! + +!ByteArrayOnBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: aBlockStorage + contents := aBlockStorage +! ! + +!ByteArrayOnBlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +copyToMemory + | sectors | + sectors := 256 * 1024. "should use 'device size' after checking ATADevices answer correctly to 'size'" + + ^ contents from: 1 to: sectors +! ! + +!ByteArrayOnBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +segmentFrom: start to: end + ^ByteArraySegment on: self from: start to: end +! ! + +!ByteArrayOnBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ contents sizeInBytes +! ! + +!ByteArrayOnBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +species + ^ByteArray +! ! + +!ByteArrayOnBlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedByteAt: byteIndex put: value + contents unsignedByteAt: byteIndex + offset put: value +! ! + +!ByteArrayOnBlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAt: byteIndex + ^ contents unsignedLongAt: byteIndex +! ! + +!ByteArrayOnBlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAt: byteIndex put: value + contents unsignedLongAt: byteIndex put: value +! ! + +!ByteArrayOnBlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAtOffset: byteOffset + ^ self unsignedLongAt: byteOffset + 1 +! ! + +!ByteArrayOnBlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAtOffset: byteOffset put: value + ^ self unsignedLongAt: byteOffset + 1 put: value +! ! + +!ByteArrayOnBlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAt: byteIndex + ^ contents unsignedShortAt: byteIndex +! ! + +!ByteArrayOnBlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAt: byteIndex put: value + contents unsignedShortAt: byteIndex put: value +! ! + +!ByteArrayOnBlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAtOffset: byteOffset + ^self unsignedShortAt: byteOffset + 1 +! ! + +!ByteArrayOnBlockDevice methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAtOffset: byteOffset put: value + ^ self unsignedShortAt: byteOffset + 1 put: value +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ByteArrayOnBlockDevice class' category: 'SqueakNOS-Storage'! +ByteArrayOnBlockDevice class + instanceVariableNames: ''! + +!ByteArrayOnBlockDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aBlockStorage + + ^self new contents: aBlockStorage +! ! + + diff --git a/modules/NOS/Storage/ByteArrayOnStream.Class.st b/modules/NOS/Storage/ByteArrayOnStream.Class.st new file mode 100644 index 00000000..09479892 --- /dev/null +++ b/modules/NOS/Storage/ByteArrayOnStream.Class.st @@ -0,0 +1,79 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ByteArrayOnStream category: 'SqueakNOS-Storage'! +ArrayedCollection subclass: #ByteArrayOnStream + instanceVariableNames: 'stream' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!ByteArrayOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger + ^ self byteAt: anInteger +! ! + +!ByteArrayOnStream methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger put: byte + ^self byteAt: anInteger put: byte +! ! + +!ByteArrayOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteAt: index + ^stream position: index - 1; next +! ! + +!ByteArrayOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteAt: index put: anInteger + ^ stream + position: index - 1; + nextPut: anInteger +! ! + +!ByteArrayOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytesAt: byteIndex count: count + ^ stream + position: byteIndex - 1; + next: count +! ! + +!ByteArrayOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +segmentFrom: start to: end + ^ByteArraySegment on: self from: start to: end +! ! + +!ByteArrayOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ stream size +! ! + +!ByteArrayOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +species + ^ByteArray +! ! + +!ByteArrayOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +stream: aStream + stream := aStream +! ! + +!ByteArrayOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAt: byteIndex +^(self bytesAt: byteIndex count: 4) unsignedLongAt: 1 +! ! + +!ByteArrayOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAt: byteIndex + ^(self bytesAt: byteIndex count: 2) unsignedShortAt: 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ByteArrayOnStream class' category: 'SqueakNOS-Storage'! +ByteArrayOnStream class + instanceVariableNames: ''! + +!ByteArrayOnStream class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aStream + ^ self new stream: aStream +! ! + + diff --git a/modules/NOS/Storage/ByteArraySegment.Class.st b/modules/NOS/Storage/ByteArraySegment.Class.st new file mode 100644 index 00000000..8e542196 --- /dev/null +++ b/modules/NOS/Storage/ByteArraySegment.Class.st @@ -0,0 +1,213 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ByteArraySegment category: 'SqueakNOS-Storage'! +ArrayedCollection subclass: #ByteArraySegment + instanceVariableNames: 'contents offset size' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!ByteArraySegment commentStamp: '' prior: 0! + +I represent a logical segment of bytes inside a byte-array like object. + +I remap the logical indexes accessed to indexes in the owner contents. +I can be nested. +! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +asByteArray + ^self copyFrom: 1 to: size +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger + ^self byteAt: anInteger +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: anInteger put: byte + ^self byteAt: anInteger put: byte +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteAt: index + self validateIndex: index. + ^ contents byteAt: offset + index +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteAt: index put: byte + self validateIndex: index. + ^ contents byteAt: offset + index put: byte +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteAtOffset: anInteger + ^self byteAt: anInteger + 1 +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +byteAtOffset: anInteger put: byte + ^self byteAt: anInteger + 1 put: byte +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytesAtOffset: anInteger put: anByteArray + self + replaceFrom: anInteger + 1 + to: anInteger + anByteArray sizeInBytes + with: anByteArray + startingAt: 1 +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +copyFrom: start to: end + | s | + self validateIndex: start toIndex: end. + ^contents copyFrom: offset + start to: offset + end +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +endOffset + ^offset + size +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +errorInBounds: anInteger + self error: 'out of bounds: ', anInteger printString +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +offset + ^offset +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +offset: anInteger + offset := anInteger +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aByteArray from: start to: stop + contents := aByteArray. + offset := start - 1. + size := stop - start + 1 . size >= 0 + ifFalse: [ self halt ] +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +replaceBytes: count with: aCollection + count > size ifTrue: [self validateIndex: count]. + self replaceFrom: 1 to: count with: aCollection +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +replaceFrom: start to: end with: another + ^self replaceFrom: start to: end with: another startingAt: 1 +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +replaceFrom: start to: end with: another startingAt: index + self validateIndex: start toIndex: end. + ^contents + replaceFrom: offset + start + to: offset + end + with: another + startingAt: index +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +segmentFrom: index size: anInteger + ^ByteArraySegment on: self from: index size: anInteger +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +segmentFrom: start to: end + ^ ByteArraySegment on: self from: start to: end +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^size +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +sizeInBytes + ^size +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedByteAt: byteIndex put: value + contents unsignedByteAt: byteIndex + offset put: value +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAt: byteIndex + (1 <= byteIndex and: [ byteIndex + 3 <= size ]) + ifFalse: [ self errorInBounds: byteIndex ]. + ^ contents unsignedLongAt: byteIndex + offset +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAt: byteIndex put: value + contents unsignedLongAt: byteIndex + offset put: value +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAtOffset: byteOffset + ^ self unsignedLongAt: byteOffset + 1 +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedLongAtOffset: byteOffset put: value + ^ self unsignedLongAt: byteOffset + 1 put: value +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAt: byteIndex + ^ contents unsignedShortAt: byteIndex + offset +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAt: byteIndex put: value + contents unsignedShortAt: byteIndex + offset put: value +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAtOffset: byteOffset + ^self unsignedShortAt: byteOffset + 1 +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +unsignedShortAtOffset: byteOffset put: value + ^ self unsignedShortAt: byteOffset + 1 put: value +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +validateIndex: index + (index between: 1 and: size) ifFalse: [self errorInBounds: index] +! ! + +!ByteArraySegment methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +validateIndex: start toIndex: end + 1 <= start ifFalse: [self errorInBounds: start]. + end <= size ifFalse: [self errorInBounds: end] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ByteArraySegment class' category: 'SqueakNOS-Storage'! +ByteArraySegment class + instanceVariableNames: ''! + +!ByteArraySegment class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aByteArray from: start size: size + ^self on: aByteArray from: start to: start + size - 1 +! ! + +!ByteArraySegment class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aByteArray from: start to: stop + ^self new on: aByteArray from: start to: stop +! ! + + diff --git a/modules/NOS/Storage/CheapHardDiskStream.Class.st b/modules/NOS/Storage/CheapHardDiskStream.Class.st new file mode 100644 index 00000000..5717ac2a --- /dev/null +++ b/modules/NOS/Storage/CheapHardDiskStream.Class.st @@ -0,0 +1,116 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #CheapHardDiskStream category: 'SqueakNOS-Storage'! +StandardFileStream subclass: #CheapHardDiskStream + instanceVariableNames: 'fileSize offset' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!CheapHardDiskStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +device: device + fileID := device. + buffer1 := String new: 1. + name := device printString. + position := 0. + offset := 0. + fileSize := 199493210. + rwmode := true. + self enableReadBuffering +! ! + +!CheapHardDiskStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fileSize + "Answer the value of fileSize" + + ^ fileSize +! ! + +!CheapHardDiskStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +fileSize: anObject + "Set the value of fileSize" + + fileSize := anObject +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primAtEnd: id + ^(self primSize: id) = position +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primClose: id +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primCloseNoError: id +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primFlush: id + id flush +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primGetPosition: id + ^offset +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primRead: aDriveNumber into: byteArray startingAt: startIndex count: count + + fileID + readInto: byteArray + startWritingAtByte: startIndex + startReadingAtByte: offset + 1 + bytesCount: count. + + offset := offset + count. + ^count + +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primSetPosition: id to: anInteger + anInteger > fileSize ifTrue: [self error: 'Out of bounds']. + offset := anInteger +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primSize: id + ^offset +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primSizeNoError: id + ^self primSize: id +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primTruncate: id to: anInteger +! ! + +!CheapHardDiskStream methodsFor: 'primitives' stamp: 'KenD 28/Jun/2026 13:32:25'! +primWrite: aDriveNumber from: stringOrByteArray startingAt: startIndex count: count + "remember that fileID isn't an ID but actually an ATA Device." + | pos | + pos := self primGetPosition: fileID. + fileID replaceFromByte: offset + 1 bytesCount: count + with: stringOrByteArray startingAtByte: startIndex. + fileSize := fileSize max: pos + count. + self primSetPosition: fileID to: pos + count. + ^count + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'CheapHardDiskStream class' category: 'SqueakNOS-Storage'! +CheapHardDiskStream class + instanceVariableNames: ''! + +!CheapHardDiskStream class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: anATADevice + ^self new device: anATADevice. +! ! + + diff --git a/modules/NOS/Storage/DualTestBlockDevice.Class.st b/modules/NOS/Storage/DualTestBlockDevice.Class.st new file mode 100644 index 00000000..3ffa5200 --- /dev/null +++ b/modules/NOS/Storage/DualTestBlockDevice.Class.st @@ -0,0 +1,69 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #DualTestBlockDevice category: 'SqueakNOS-Storage'! +BlockDevice subclass: #DualTestBlockDevice + instanceVariableNames: 'deviceA deviceB' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!DualTestBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: aBlockNumber + "Retrieve sector number aBlockNumber from device" + + | result | + result := deviceA at: aBlockNumber. + (deviceB at: aBlockNumber) = result + ifFalse: [ self error: 'Read failed' ]. + ^ result +! ! + +!DualTestBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: aBlockNumber count: blocksCount + "Retrieve sector number aBlockNumber from device" + + | result | + result := deviceA at: aBlockNumber count: blocksCount. + (deviceB at: aBlockNumber count: blocksCount) = result + ifFalse: [ self error: 'Read failed' ]. + ^ result +! ! + +!DualTestBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: firstBlockNumber writeArray: aByteArray + "Write aByteArray to disk starting at firstBlockNumber. aByteArray size should be multiple of the sector size" + + deviceA at: firstBlockNumber writeArray: aByteArray. + deviceB at: firstBlockNumber writeArray: aByteArray. + self at: firstBlockNumber count: aByteArray size / self blockSize +! ! + +!DualTestBlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockSize + ^deviceA blockSize. +! ! + +!DualTestBlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +deviceA: aDeviceA deviceB: aDeviceB + deviceA := aDeviceA. + deviceB := aDeviceB. +! ! + +!DualTestBlockDevice methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +from: firstBlockNumber to: lastBlockNumber + "Retrieve sectorst from firstBlockNumber to lastBlockNumber" + + ^self at: firstBlockNumber count: lastBlockNumber - firstBlockNumber + 1. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'DualTestBlockDevice class' category: 'SqueakNOS-Storage'! +DualTestBlockDevice class + instanceVariableNames: ''! + +!DualTestBlockDevice class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +deviceA: aDeviceA deviceB: aDeviceB + ^(self basicNew deviceA: aDeviceA deviceB: aDeviceB) initialize. +! ! + + diff --git a/modules/NOS/Storage/MasterBootRecord.Class.st b/modules/NOS/Storage/MasterBootRecord.Class.st new file mode 100644 index 00000000..be07d95c --- /dev/null +++ b/modules/NOS/Storage/MasterBootRecord.Class.st @@ -0,0 +1,63 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #MasterBootRecord category: 'SqueakNOS-Storage'! +Object subclass: #MasterBootRecord + instanceVariableNames: 'bytes' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!MasterBootRecord commentStamp: '' prior: 0! + +The Master Boot Record is the same for pretty much all Operating Systems. It is located on the first Sector of the Hard Drive, at Cylinder 0, Head 0, Sector 1. It is the first piece of code that your computer runs after it has checked all of your hardware (POST) and turned control of loading software over the hard drive. + + It also contains the partition table, which defines the different sections of your hard drive. Basically if anything happens to this little 512 byte section, your hard drive is brain dead. + +Offset Description Size +000h Executable Code (Boots Computer) 446 Bytes +1BEh 1st Partition Entry (See Next Table) 16 Bytes +1CEh 2nd Partition Entry 16 Bytes +1DEh 3rd Partition Entry 16 Bytes +1EEh 4th Partition Entry 16 Bytes +1FEh Boot Record Signature (55h AAh) 2 Bytes + + +! + +!MasterBootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aBytesArray + bytes := aBytesArray. +! ! + +!MasterBootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +offsetToPartition: aNumber sectorSize: aSectorSize + "Gets the partition record number aNumber. There are 4 of them, each occupies 16 bytes and + are placed in a table. aNumber can be 1, 2, 3 or 4. + Result is 0-indexed" + + ^ (self partitionRecord: aNumber) offsetFromMBR * (aSectorSize ifNil: [ 512 ]) +! ! + +!MasterBootRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +partitionRecord: index + "Gets the partition record number index. There are 4 of them, each occupies 16 bytes and + are placed in a table. index can be 1, 2, 3 or 4" + + | start | + start := 447 + (16 * (index - 1)). + ^ PartitionRecord with: (bytes segmentFrom: start to: start + 15) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MasterBootRecord class' category: 'SqueakNOS-Storage'! +MasterBootRecord class + instanceVariableNames: ''! + +!MasterBootRecord class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: bytes + bytes size ~= 512 + ifTrue: [ self error: 'Not a Master Boot Record' ]. + ^ self new bytes: bytes +! ! + + diff --git a/modules/NOS/Storage/MemoryBlockDevice.Class.st b/modules/NOS/Storage/MemoryBlockDevice.Class.st new file mode 100644 index 00000000..7685bd42 --- /dev/null +++ b/modules/NOS/Storage/MemoryBlockDevice.Class.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #MemoryBlockDevice category: 'SqueakNOS-Storage'! +BlockDevice subclass: #MemoryBlockDevice + instanceVariableNames: 'contents blockSize' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!MemoryBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: aBlockNumber + "Retrieve sector number aBlockNumber from device" + | start end | + start := aBlockNumber - 1 * blockSize + 1. + end := start + blockSize. + ^contents copyFrom: start to: end +! ! + +!MemoryBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockSize + ^blockSize +! ! + +!MemoryBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +blockSize: anInteger + blockSize := anInteger +! ! + +!MemoryBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents + ^contents +! ! + +!MemoryBlockDevice methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents: anInteger + contents := anInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MemoryBlockDevice class' category: 'SqueakNOS-Storage'! +MemoryBlockDevice class + instanceVariableNames: ''! + +!MemoryBlockDevice class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: bytes blockSize: blockSize + ^self new contents: bytes; blockSize: blockSize +! ! + + diff --git a/modules/NOS/Storage/NullBlockCache.Class.st b/modules/NOS/Storage/NullBlockCache.Class.st new file mode 100644 index 00000000..bbabc2c5 --- /dev/null +++ b/modules/NOS/Storage/NullBlockCache.Class.st @@ -0,0 +1,94 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #NullBlockCache category: 'SqueakNOS-Storage'! +Object subclass: #NullBlockCache + instanceVariableNames: 'device' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!NullBlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +flushWrites +! ! + +!NullBlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +from: firstBlock to: lastBlock + ^device from: firstBlock to: lastBlock. + + +! ! + +!NullBlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aDevice + device := aDevice. +! ! + +!NullBlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +readInto: byteArray startWritingAtByte: destOffset startReadingAtByte: sourceOffset bytesCount: bytesCount + + | data firstBlock lastBlock firstBlockBytesOffset | + firstBlock := device blockNumberFromByteIndex: sourceOffset. + lastBlock := device blockNumberFromByteIndex: sourceOffset + bytesCount - 1. + + data := device from: firstBlock to: lastBlock. + + firstBlockBytesOffset := device positionInBlockOf: sourceOffset. + byteArray replaceFrom: destOffset to: destOffset + bytesCount - 1 with: data startingAt: firstBlockBytesOffset. + ^bytesCount. + + +! ! + +!NullBlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +replaceFromByte: destOffset bytesCount: bytesCount with: source startingAtByte: sourceOffset + "Write count bytes from source starting at startIndex bytes. We handle half sector + overwriting." + | data firstBlock lastBlock blocksCount firstBlockBytesOffset lastBlockBytesCount blockData firstSectorRead | + + firstBlock := device blockNumberFromByteIndex: destOffset. + lastBlock := device blockNumberFromByteIndex: destOffset + bytesCount - 1. + blocksCount := lastBlock - firstBlock + 1. + + firstSectorRead := false. + + data := ByteArray new: blocksCount * device blockSize. + + "If it starts at block boundaries, we don't need to read the block. We'll probably overwrite it entirely" + firstBlockBytesOffset := device positionInBlockOf: destOffset. + firstBlockBytesOffset ~= 1 ifTrue: [ + firstSectorRead := true. + blockData := device at: firstBlock. + data replaceFrom: 1 to: device blockSize with: blockData startingAt: 1. + ]. + + "If it ends at block boundaries, we don't need to read the last block. We'll probably overwrite it entirely" + lastBlockBytesCount := device positionInBlockOf: destOffset + bytesCount - 1. + lastBlockBytesCount ~= device blockSize ifTrue: [ + (blocksCount = 1 & firstSectorRead) ifFalse: [ + blockData := device at: lastBlock. + data replaceFrom: 1 to: device blockSize with: blockData startingAt: 1. + ]. + ]. + + data + replaceFrom: firstBlockBytesOffset to: (firstBlockBytesOffset + bytesCount - 1) + with: source startingAt: sourceOffset. + + Transcript show: 'Writing ', blocksCount asString, ' sectors starting at ', firstBlock asString, ' + '. + device at: firstBlock writeArray: data. + + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'NullBlockCache class' category: 'SqueakNOS-Storage'! +NullBlockCache class + instanceVariableNames: ''! + +!NullBlockCache class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aDevice + ^self new on: aDevice +! ! + + diff --git a/modules/NOS/Storage/PartitionRecord.Class.st b/modules/NOS/Storage/PartitionRecord.Class.st new file mode 100644 index 00000000..681f3e37 --- /dev/null +++ b/modules/NOS/Storage/PartitionRecord.Class.st @@ -0,0 +1,142 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #PartitionRecord category: 'SqueakNOS-Storage'! +Object subclass: #PartitionRecord + instanceVariableNames: 'bytes' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!PartitionRecord commentStamp: '' prior: 0! + +It is a 16 bytes table contained inside the MBR, it's contents are: + +Offset Description Size +00h Current State of Partition (00h=Inactive, 80h=Active) 1 Byte +01h Beginning of Partition - Head 1 Byte +02h Beginning of Partition - Cylinder/Sector (See Below) 1 Word +04h Type of Partition (See List Below) 1 Byte +05h End of Partition - Head 1 Byte +06h End of Partition - Cylinder/Sector 1 Word +08h Number of Sectors Between the MBR and the First Sector in the Partition 1 Double Word +0Ch Number of Sectors in the Partition 1 Double Word + + + +! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +active + "00h Current State of Partition (00h=Inactive, 80h=Active) 1 Byte" + ^(bytes byteAt: 1) = 16r80. +! ! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +bytes: aByteArray + bytes := aByteArray. +! ! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +decodedCylinderLow: encodedCylSecLow high: encodedCylSecHigh + " + + 15 14 13 12 11 10 9 8 | 7 6 | 5 4 3 2 1 0 + + | Cylinder Bits 7 to 0 | Cylinder | Sector | + + | Bits 9+8 | Bits 5 to 0 + + " + ^encodedCylSecHigh bitOr: ((encodedCylSecLow bitAnd: 16rC0) bitShift: 2). +! ! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +decodedSector: encodedCylSec + " + + 15 14 13 12 11 10 9 8 | 7 6 | 5 4 3 2 1 0 + + | Cylinder Bits 7 to 0 | Cylinder | Sector | + + | Bits 9+8 | Bits 5 to 0 + + " + ^encodedCylSec bitAnd: 16r3F. +! ! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstCylinder + "01h - Beginning of Partition - Cylinder/Sector - 2 Byte + " + ^self decodedCylinderLow: (bytes byteAt: 3) high: (bytes byteAt: 4). +! ! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstHead + "01h Beginning of Partition - Head 1 Byte" + ^bytes byteAt: 2. +! ! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +firstSector + "01h - Beginning of Partition - Cylinder/Sector - 2 Byte" + ^self decodedSector: (bytes byteAt: 3). +! ! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +inactive + "00h Current State of Partition (00h=Inactive, 80h=Active) 1 Byte" + ^(bytes byteAt: 1) = 16r00. +! ! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +numberOfSectors + "08h Number of Sectors in the Partition. 1 Double Word" + ^bytes unsignedLongAt: 13. +! ! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +offsetFromMBR + "08h Number of Sectors Between the MBR and the First Sector in the Partition. 1 Double Word" + ^bytes unsignedLongAt: 9. +! ! + +!PartitionRecord methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:32:25'! +partitionSegmentOn: aBlockDevice + + ^ aBlockDevice segmentFrom: self offsetFromMBR +1 size: self numberOfSectors +! ! + +!PartitionRecord methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +partitionType + "04h - Type of Partition - 1 Byte " + + ^self class partitionTypes at: (bytes byteAt: 5) ifAbsent: [ ^#unknown]. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PartitionRecord class' category: 'SqueakNOS-Storage'! +PartitionRecord class + instanceVariableNames: ''! + +!PartitionRecord class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +partitionTypes + "source: + http://home.teleport.com/~brainy/fat32.htm and + http://www.win.tue.nl/~aeb/partitions/partition_types-1.html" + + | types | + types := Dictionary new. + types at: 16r00 put: #Unknown; + at: 16r01 put: #FAT12; + at: 16r04 put: #FAT16; "16-bit FAT (Partition Smaller than 32MB)" + at: 16r05 put: #ExtendedMSDOS; + at: 16r06 put: #FAT16Large; "16-bit FAT (Partition Larger than 32MB)" + at: 16r0B put: #FAT32; "32-bit FAT (Partition Up to 2048GB)" + at: 16r0C put: #FAT32LBA; "Same as 0BH, but uses LBA1 13h Extensions" + at: 16r0E put: #FAT16LargeLBA; "Same as 06H, but uses LBA1 13h Extensions" + at: 16r0F put: #ExtendedMSDOSLBA; "Same as 05H, but uses LBA1 13h Extensions" + at: 16r83 put: #Linux. "Various filesystem types like xiafs, ext2, ext3, reiserfs, etc. all use ID 83". + + ^types. +! ! + +!PartitionRecord class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +with: anArray + anArray size ~= 16 ifTrue: [self error: 'Not a Partition Record']. + ^self new bytes: anArray. +! ! + + diff --git a/modules/NOS/Storage/ReadBlockCache.Class.st b/modules/NOS/Storage/ReadBlockCache.Class.st new file mode 100644 index 00000000..3fcbcd8e --- /dev/null +++ b/modules/NOS/Storage/ReadBlockCache.Class.st @@ -0,0 +1,91 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #ReadBlockCache category: 'SqueakNOS-Storage'! +Object subclass: #ReadBlockCache + instanceVariableNames: 'device cache count' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!ReadBlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +flushWrites +! ! + +!ReadBlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +from: firstBlock to: lastBlock + | data | + "Very primitive caching mechanism" + (firstBlock = (cache at: 1)) & (lastBlock = (cache at: 2)) ifFalse: [ + data := device from: firstBlock to: lastBlock. + cache := Array with: firstBlock with: lastBlock with: data. + ] ifTrue: [ data := cache at: 3]. + + ^data. + + +! ! + +!ReadBlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aDevice + device := aDevice. + cache := Array with: nil with: nil with: nil. + count := 0. +! ! + +!ReadBlockCache methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +replaceFromByte: destOffset bytesCount: bytesCount with: source startingAtByte: sourceOffset + "Write count bytes from source starting at startIndex bytes. We handle half sector + overwriting." + | data firstBlock lastBlock blocksCount firstBlockBytesOffset lastBlockBytesCount blockData firstSectorRead | + + firstBlock := device blockNumberFromByteIndex: destOffset. + lastBlock := device blockNumberFromByteIndex: destOffset + bytesCount - 1. + blocksCount := lastBlock - firstBlock + 1. + + firstSectorRead := false. + + data := ByteArray new: blocksCount * device blockSize. + cache := Array with: nil with: nil with: nil. + "If it starts at block boundaries, we don't need to read the block. We'll probably overwrite it entirely" + firstBlockBytesOffset := device positionInBlockOf: destOffset. + firstBlockBytesOffset ~= 1 ifTrue: [ + firstSectorRead := true. + blockData := device at: firstBlock. + data replaceFrom: 1 to: device blockSize with: blockData startingAt: 1. + ]. + + "If it ends at block boundaries, we don't need to read the last block. We'll probably overwrite it entirely" + lastBlockBytesCount := device positionInBlockOf: destOffset + bytesCount - 1. + lastBlockBytesCount ~= device blockSize ifTrue: [ + (blocksCount = 1 & firstSectorRead) ifFalse: [ + blockData := device at: lastBlock. + data replaceFrom: 1 to: device blockSize with: blockData startingAt: 1. + ]. + ]. + + data + replaceFrom: firstBlockBytesOffset to: (firstBlockBytesOffset + bytesCount - 1) + with: source startingAt: sourceOffset. + + count > 10000 ifTrue: [ count := 0. + "Transcript show: 'Writing ', blocksCount asString, ' sectors starting at ', firstBlock asString, ' +'." + ]. + count := count + bytesCount. + + device at: firstBlock writeArray: data. + + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ReadBlockCache class' category: 'SqueakNOS-Storage'! +ReadBlockCache class + instanceVariableNames: ''! + +!ReadBlockCache class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aDevice + ^self new on: aDevice +! ! + + diff --git a/modules/NOS/Storage/Segment.Class.st b/modules/NOS/Storage/Segment.Class.st new file mode 100644 index 00000000..b1d749d3 --- /dev/null +++ b/modules/NOS/Storage/Segment.Class.st @@ -0,0 +1,22 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #Segment category: 'SqueakNOS-Storage'! +Interval subclass: #Segment + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!Segment methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +intersects: anotherSegment + start > anotherSegment stop ifTrue: [^false]. + stop < anotherSegment start ifTrue: [^false]. + ^true. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Segment class' category: 'SqueakNOS-Storage'! +Segment class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Storage/StreamOnStream.Class.st b/modules/NOS/Storage/StreamOnStream.Class.st new file mode 100644 index 00000000..83d88e89 --- /dev/null +++ b/modules/NOS/Storage/StreamOnStream.Class.st @@ -0,0 +1,86 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #StreamOnStream category: 'SqueakNOS-Storage'! +PositionableStream subclass: #StreamOnStream + instanceVariableNames: 'contentLength offset stream' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!StreamOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +contents + | contents pos | + pos := self position. + self position: 0. + contents := self next: self size. + self position: pos. + ^contents +! ! + +!StreamOnStream methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +new + ^self basicNew +! ! + +!StreamOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +next + ^stream next +! ! + +!StreamOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +next: anInteger + ^stream next: anInteger +! ! + +!StreamOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +nextPut: aCharacter + self atEnd ifFalse: [ + (stream nextPut: aCharacter) ifNotNil: [:char | + position := position + 1. + ^char + ] + ] +! ! + +!StreamOnStream methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aStream + ^self on: aStream offset: 0. +! ! + +!StreamOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aStream from: anIndex to: anOffset + stream := aStream clone. + stream setFrom: anIndex to: anOffset. + self setFrom: 1 to: anOffset - anIndex. + offset := anIndex. + self binary +! ! + +!StreamOnStream methodsFor: 'methodsFor:' stamp: 'KenD 28/Jun/2026 13:32:25'! +on: aStream offset: anOffset + ^self on: aStream offset: anOffset size: aStream size - anOffset. +! ! + +!StreamOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +position + ^position +! ! + +!StreamOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +position: aNumber + position := aNumber. + stream position: offset + aNumber + +! ! + +!StreamOnStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:25'! +size + ^ readLimit +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'StreamOnStream class' category: 'SqueakNOS-Storage'! +StreamOnStream class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Storage/Tests/BlockArithmeticTest.Class.st b/modules/NOS/Storage/Tests/BlockArithmeticTest.Class.st new file mode 100644 index 00000000..136a6ea2 --- /dev/null +++ b/modules/NOS/Storage/Tests/BlockArithmeticTest.Class.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #BlockArithmeticTest category: 'SqueakNOS-Storage'! +TestCase subclass: #BlockArithmeticTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!BlockArithmeticTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testFirstPositionInSameBlock + + | helper | + helper := BlockArithmetic new size: 512. + + self assert: (helper firstPositionInSameBlockOf: 1) = 1. + self assert: (helper firstPositionInSameBlockOf: 2) = 1. + self assert: (helper firstPositionInSameBlockOf: 300) = 1. + self assert: (helper firstPositionInSameBlockOf: 511) = 1. + self assert: (helper firstPositionInSameBlockOf: 512) = 1. + self assert: (helper firstPositionInSameBlockOf: 513) = 513. + self assert: (helper firstPositionInSameBlockOf: 514) = 513. + self assert: (helper firstPositionInSameBlockOf: 1024) = 513. + self assert: (helper firstPositionInSameBlockOf: 1025) = 1025. +! ! + +!BlockArithmeticTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testLastPositionInSameBlock + + | helper | + helper := BlockArithmetic new size: 512. + + self assert: (helper lastPositionInSameBlockOf: 1) = 512. + self assert: (helper lastPositionInSameBlockOf: 2) = 512. + self assert: (helper lastPositionInSameBlockOf: 300) = 512. + self assert: (helper lastPositionInSameBlockOf: 511) = 512. + self assert: (helper lastPositionInSameBlockOf: 512) = 512. + self assert: (helper lastPositionInSameBlockOf: 513) = 1024. + self assert: (helper lastPositionInSameBlockOf: 514) = 1024. + self assert: (helper lastPositionInSameBlockOf: 1024) = 1024. + self assert: (helper lastPositionInSameBlockOf: 1025) = 1536. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockArithmeticTest class' category: 'SqueakNOS-Storage'! +BlockArithmeticTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Storage/Tests/BlockCacheTest.Class.st b/modules/NOS/Storage/Tests/BlockCacheTest.Class.st new file mode 100644 index 00000000..bba1bc65 --- /dev/null +++ b/modules/NOS/Storage/Tests/BlockCacheTest.Class.st @@ -0,0 +1,60 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #BlockCacheTest category: #'SqueakNOS-Storage-Tests'! +TestCase subclass: #BlockCacheTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage-Tests'! +!BlockCacheTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testBigWrite + | device cache array original | + device := Computer blankBlockDeviceForTest. + cache := BlockCache on: device. + + device at: 1 writeArray: (ByteArray new: 300000). + array := ByteArray new: 200000. + 1 to: 200000 do: [ :i | array at: i put: i \\ 256 ]. + original := (device from: 2 to: 300000) asByteArray. + + original replaceFrom: 15 to: 200009 with: array startingAt: 5. + cache replaceFromByte: (15 + cache blockSize) bytesCount: 199995 with: array startingAtByte: 5. + + self assert: original = (cache from: 2 to: 300000). + +! ! + +!BlockCacheTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testRead + | device cache | + device := ATAController primary master. + cache := BlockCache on: device. + + + self assert: (device from: 10 to: 11) asByteArray = (cache from: 10 to: 11). + self assert: (device from: 1 to: 1) asByteArray = (cache from: 1 to: 1). + self assert: (device from: 100 to: 110) asByteArray = (cache from: 100 to: 110). +! ! + +!BlockCacheTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testWrite + | device cache array original | + device := ATAController primary master. + cache := BlockCache on: device. + + array := ByteArray withAll: (0 to: 255). + + original := (device at: 1) asByteArray. + original replaceFrom: 15 to: 32 with: array startingAt: 5. + cache replaceFromByte: 15 bytesCount: 18 with: array startingAtByte: 5. + + self assert: original = (cache from: 1 to: 1). +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'BlockCacheTest class' category: #'SqueakNOS-Storage-Tests'! +BlockCacheTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Storage/Tests/MemoryBlockDeviceTest.Class.st b/modules/NOS/Storage/Tests/MemoryBlockDeviceTest.Class.st new file mode 100644 index 00000000..f28614bb --- /dev/null +++ b/modules/NOS/Storage/Tests/MemoryBlockDeviceTest.Class.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #MemoryBlockDeviceTest category: 'SqueakNOS-Storage-Tests'! +TestCase subclass: #MemoryBlockDeviceTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage-Tests'! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MemoryBlockDeviceTest class' category: 'SqueakNOS-Storage-Tests'! +MemoryBlockDeviceTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Storage/Tests/StreamOnStreamTest.Class.st b/modules/NOS/Storage/Tests/StreamOnStreamTest.Class.st new file mode 100644 index 00000000..48127974 --- /dev/null +++ b/modules/NOS/Storage/Tests/StreamOnStreamTest.Class.st @@ -0,0 +1,87 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #StreamOnStreamTest category: 'SqueakNOS-Storage-Tests'! +TestCase subclass: #StreamOnStreamTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage-Tests'! +!StreamOnStreamTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:32:25'! +testInnerStreamOnStream + | changes size str1 str2 | + changes := StandardFileStream fileNamed: 'testdata/test.changes'. + size := changes size. + str1 := StreamOnStream on: changes from: changes size - 100 to: changes size. + str1 setToEnd; nextPutAll: 'test'. + str2 := StreamOnStream on: str1 offset: str1 size - 10 size: 10. + str2 setToEnd; nextPutAll: 'test'. + str2 := StreamOnStream on: str1 offset: str1 size - 10 size: 10. + str2 position: 2; nextPutAll: 'aaaaaaaa'. + changes flush; close; open: changes name forWrite: true. + self assert: changes size = (size + 8 ). + self assert: (changes contents asString last: 8) = 'aaaaaaaa'. + +! ! + +!StreamOnStreamTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testInnerStreamOnStream2 + | changes size str1 str2 data contents | + changes := StandardFileStream fileNamed: 'testdata/test.changes'. + size := changes size. + changes position: size - 10. + data := (changes next: 10) asString. + str1 := StreamOnStream + on: changes + offset: changes size - 100 + size: 100. + str2 := StreamOnStream + on: changes copy + offset: changes size - 100 + size: 100. + [str1 position: 90; + nextPutAll: 'testtestst'. + str2 position: 0; nextPutAll: 'test'. + "self assert: (str2 next: 10) = 'testtestst'." + changes flush; close; open: changes name forWrite: true. + self assert: changes size = size. + contents := changes contents asString. + self assert: (contents last: 10) asString = 'testtestst'; assert: ((contents last: 100)first: 4) = 'test'] + ensure: [changes position: size - 10; + nextPutAll: data] +! ! + +!StreamOnStreamTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testRead + | source | + source := ReadStream on: 'this is a long string to read'. + self assert: (StreamOnStream on: source from: 5 to: source size) contents asString = 'is a long string to read'. + self assert: (StreamOnStream on: source from: 5 to: 14) contents asString = 'is a long'. +! ! + +!StreamOnStreamTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testSyncronization + | changes size str1 str2 data contents | + changes := StandardFileStream fileNamed: 'testdata/test.changes'. + size := changes size. + changes position: size - 10. + data := (changes next: 10) asString. + str1 := StreamOnStream + on: changes + offset: changes size - 100 + size: 100. + [ + str1 position: 90; nextPutAll: 'testtestst'; flush; close. + contents := changes position: size - 10; next: 10. + self assert: contents asString = 'testtestst' + ] ensure: [ + changes position: size - 10; nextPutAll: data; flush; close. + ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'StreamOnStreamTest class' category: 'SqueakNOS-Storage-Tests'! +StreamOnStreamTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Storage/Tests/WriteListTest.Class.st b/modules/NOS/Storage/Tests/WriteListTest.Class.st new file mode 100644 index 00000000..efeed0c0 --- /dev/null +++ b/modules/NOS/Storage/Tests/WriteListTest.Class.st @@ -0,0 +1,42 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #WriteListTest category: 'SqueakNOS-Storage-Tests'! +TestCase subclass: #WriteListTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage-Tests'! +!WriteListTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testAddingBlocks + + | list | + list := WriteList new. + + list reserve: 5 at: 10. + list reserve: 10 at: 50. + list reserve: 15 at: 18. + list reserve: 3 at: 15. + + self assert: list blocks = (OrderedCollection with: { 10. 18+ 15 } with: { 50. 60 }). +! ! + +!WriteListTest methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +testAddingContiguousBlocks + + | list | + list := WriteList new. + + list reserve: 1 at: 28322905. + list reserve: 1 at: 28322906. + list reserve: 64 at: 28322907. + + self assert: list blocks = (OrderedCollection with: { 28322905. 28322907 + 64 }). +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WriteListTest class' category: 'SqueakNOS-Storage-Tests'! +WriteListTest class + instanceVariableNames: ''! + + diff --git a/modules/NOS/Storage/WriteList.Class.st b/modules/NOS/Storage/WriteList.Class.st new file mode 100644 index 00000000..e944d993 --- /dev/null +++ b/modules/NOS/Storage/WriteList.Class.st @@ -0,0 +1,134 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:25 pm'! +!classDefinition: #WriteList category: 'SqueakNOS-Storage'! +Object subclass: #WriteList + instanceVariableNames: 'writeQueue blocksList' + classVariableNames: '' + poolDictionaries: '' + category: 'SqueakNOS-Storage'! +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +areIntersected: firstA to: lastA and: firstB to: lastB + firstA > lastB ifTrue: [^false]. + lastA < firstB ifTrue: [^false]. + ^true. +! ! + +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +at: aPosition wrote: someData + self reserve: someData size at: aPosition. + writeQueue add: { aPosition. someData } +! ! + +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +blocks + ^ blocksList +! ! + +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +clear + + writeQueue := OrderedCollection new. + blocksList := OrderedCollection new. +! ! + +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +do: aBlock + blocksList do: [ :block | aBlock value: (block at: 1) value: (block at: 2) - 1 value: + (writeQueue select: [ :write | (block at: 1) <= (write at: 1) and: [(block at: 2) > (write at: 1)] ]) ]. +! ! + +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +findLeftStart: startPosition end: endPosition + + blocksList withIndexDo: [ :elem :index | + ((elem at: 2) >= startPosition) ifTrue: [ + ((elem at: 1) <= endPosition) ifTrue: [^{index. true}] ifFalse: [^{index. false}]. + ]. + ]. + ^{blocksList size + 1. false}. + + +! ! + +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +findRightStart: startPosition end: endPosition + | last | + blocksList withIndexDo: [ :elem :index | + ((elem at: 1) <= endPosition) + ifTrue: [ + last := index. + ] ifFalse: [ + ^last. + ]. + ]. + ^last. + + +! ! + +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +initialize + self clear. +! ! + +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +removeAllNecesaryFrom: startPosition to: endPosition ifAdd: aBlock + | left right newStartPosition newEndPosition | + left := self findLeftStart: startPosition end: endPosition. + + (left at: 2) ifFalse: [ + aBlock value: (left at: 1) value: startPosition value: endPosition. + ] ifTrue: [ + newStartPosition := startPosition min: ((blocksList at: (left at: 1)) at: 1). + + right := self findRightStart: startPosition end: endPosition. + newEndPosition := endPosition max: ((blocksList at: right) at: 2). + + "(((left at: 1) == right) and: [(newStartPosition <= startPosition and: [ newEndPosition >= endPosition ])]) ifFalse: [" + right to: (left at: 1) by: -1 do: [ :index | blocksList removeAt: index ]. + aBlock value: (left at: 1) value: newStartPosition value: newEndPosition. + "]" + ] + + + +! ! + +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +reserve: size at: startPosition + + | endPosition | + endPosition := startPosition + size. + + self removeAllNecesaryFrom: startPosition to: endPosition ifAdd: [ :index :newStartPosition :newEndPosition | + blocksList add: {newStartPosition. newEndPosition} beforeIndex: index. + ]. + +! ! + +!WriteList methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:32:25'! +writeFrom: firstByte to: lastByte into: aByteArray + | helper | + helper := BlockArithmetic new blockSize: aByteArray size. + + "self halt." + writeQueue do: [ :write | | sourceStart sourceEnd | + sourceStart := write at: 1. + sourceEnd := sourceStart + (write at: 2) size - 1. + (self areIntersected: firstByte to: lastByte and: sourceStart to: sourceEnd) ifTrue: [ | destStart destEnd | + destStart := helper positionInBlockOf: (firstByte max: sourceStart). + destEnd := helper positionInBlockOf: (lastByte min: sourceEnd). + aByteArray replaceFrom: destStart to: destEnd with: (write at: 2) startingAt: (firstByte - sourceStart + 1 max: 1) + ] + ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WriteList class' category: 'SqueakNOS-Storage'! +WriteList class + instanceVariableNames: ''! + + +WriteList initialize! + diff --git a/modules/PetitParser/Extensions/Character.Extension.st b/modules/PetitParser/Extensions/Character.Extension.st new file mode 100644 index 00000000..b6d6448d --- /dev/null +++ b/modules/PetitParser/Extensions/Character.Extension.st @@ -0,0 +1,27 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Character methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +asParser + ^ PPLiteralObjectParser on: self +! ! + +!Character methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +parserTo: aCharacter + ^PPPredicateObjectParser between: self and: aCharacter +! ! + +!Character methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +sameAs: aCharacter + ^self asLowercase = aCharacter asLowercase +! ! + +!Character class methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +codePoint: anInteger + " + Just for ANSI Compliance + " + ^self value: anInteger +! ! + + diff --git a/modules/PetitParser/Extensions/CharacterArray.Extension.st b/modules/PetitParser/Extensions/CharacterArray.Extension.st new file mode 100644 index 00000000..a62d4d23 --- /dev/null +++ b/modules/PetitParser/Extensions/CharacterArray.Extension.st @@ -0,0 +1,15 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!CharacterArray methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyReplaceAll: aString with: anotherString + ^self replaceAll: aString with: anotherString + +! ! + +!CharacterArray methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +sameAs: aString + ^self equalsCaseInsensitive: aString +! ! + + diff --git a/modules/PetitParser/Extensions/Closure.Extension.st b/modules/PetitParser/Extensions/Closure.Extension.st new file mode 100644 index 00000000..aa2880af --- /dev/null +++ b/modules/PetitParser/Extensions/Closure.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Closure methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +asParser + ^PPPluggableParser on: self +! ! + + diff --git a/modules/PetitParser/Extensions/ExtensionsModule.Class.st b/modules/PetitParser/Extensions/ExtensionsModule.Class.st new file mode 100644 index 00000000..f6184406 --- /dev/null +++ b/modules/PetitParser/Extensions/ExtensionsModule.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ExtensionsModule category: #PetitParser! +Module subclass: #ExtensionsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'PetitParser'! +!ExtensionsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #Kernel -> #(#CharacterArray #Closure #ReadStream #SequenceableCollection #Symbol #UndefinedObject) + } +! ! + +!ExtensionsModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + self name: #'PetitParser.Extensions' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExtensionsModule class' category: #PetitParser! +ExtensionsModule class + instanceVariableNames: ''! + + +ExtensionsModule initialize! + diff --git a/modules/PetitParser/Extensions/Object.Extension.st b/modules/PetitParser/Extensions/Object.Extension.st new file mode 100644 index 00000000..922cb8c9 --- /dev/null +++ b/modules/PetitParser/Extensions/Object.Extension.st @@ -0,0 +1,19 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Object methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +asParser + ^ PPPredicateObjectParser expect: self +! ! + +!Object methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPetitFailure + ^ false +! ! + +!Object methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPetitParser + ^ false +! ! + + diff --git a/modules/PetitParser/Extensions/ReadStream.Extension.st b/modules/PetitParser/Extensions/ReadStream.Extension.st new file mode 100644 index 00000000..9e916640 --- /dev/null +++ b/modules/PetitParser/Extensions/ReadStream.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!ReadStream methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +asPetitStream + ^self collection asPetitStream +! ! + + diff --git a/modules/PetitParser/Extensions/SequenceableCollection.Extension.st b/modules/PetitParser/Extensions/SequenceableCollection.Extension.st new file mode 100644 index 00000000..84c817d6 --- /dev/null +++ b/modules/PetitParser/Extensions/SequenceableCollection.Extension.st @@ -0,0 +1,19 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!SequenceableCollection methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +asParser + ^PPSequenceParser withAll: (self collect: [:e | e asParser]) +! ! + +!SequenceableCollection methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +asPetitStream + ^ PPStream on: self +! ! + +!SequenceableCollection methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +keysAndValuesDo: aBlock + 1 to: self size do: [:i | aBlock value: i value: (self atValid: i)] +! ! + + diff --git a/modules/PetitParser/Extensions/Set.Extension.st b/modules/PetitParser/Extensions/Set.Extension.st new file mode 100644 index 00000000..09e654bf --- /dev/null +++ b/modules/PetitParser/Extensions/Set.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Set methodsFor: '*Parsers' stamp: 'KenD 28/Jun/2026 13:27:39'! +asParser + ^ PPChoiceParser withAll: (self collect: [ :each | each asParser ]) +! ! + + diff --git a/modules/PetitParser/Extensions/Symbol.Extension.st b/modules/PetitParser/Extensions/Symbol.Extension.st new file mode 100644 index 00000000..28277f9d --- /dev/null +++ b/modules/PetitParser/Extensions/Symbol.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Symbol methodsFor: '*Extensions' stamp: 'KenD 28/Jun/2026 13:27:39'! +value: anObject + ^anObject perform: self +! ! + + diff --git a/modules/PetitParser/Extensions/UndefinedObject.Extension.st b/modules/PetitParser/Extensions/UndefinedObject.Extension.st new file mode 100644 index 00000000..4876bfc5 --- /dev/null +++ b/modules/PetitParser/Extensions/UndefinedObject.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!UndefinedObject methodsFor: '*Parsers' stamp: 'KenD 28/Jun/2026 13:27:39'! +asParser + ^ PPEpsilonParser new +! ! + + diff --git a/modules/PetitParser/PPFailure.Class.st b/modules/PetitParser/PPFailure.Class.st new file mode 100644 index 00000000..821db3d5 --- /dev/null +++ b/modules/PetitParser/PPFailure.Class.st @@ -0,0 +1,65 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPFailure category: #PetitParser! +Object subclass: #PPFailure + instanceVariableNames: 'message position' + classVariableNames: '' + poolDictionaries: '' + category: 'PetitParser'! +!PPFailure commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPFailure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +description + ^message +! ! + +!PPFailure methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPetitFailure + "I am the only class that should implement this method to return true." + + ^ true +! ! + +!PPFailure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +message + "Answer a human readable error message of this parse failure." + + ^ message +! ! + +!PPFailure methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +message: aString from: aStream + message := aString. + position := aStream position. + aStream failure: self +! ! + +!PPFailure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +position + "Answer the position in the source string that caused this parse failure." + + ^ position +! ! + +!PPFailure methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: self message; nextPutAll: ' at '; print: position +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPFailure class' category: #PetitParser! +PPFailure class + instanceVariableNames: ''! + +!PPFailure class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +message: aString from: aStream + ^self basicNew message: aString from: aStream +! ! + + diff --git a/modules/PetitParser/PPMemento.Class.st b/modules/PetitParser/PPMemento.Class.st new file mode 100644 index 00000000..ea73332f --- /dev/null +++ b/modules/PetitParser/PPMemento.Class.st @@ -0,0 +1,60 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPMemento category: #PetitParser! +Object subclass: #PPMemento + instanceVariableNames: 'result count position' + classVariableNames: '' + poolDictionaries: '' + category: 'PetitParser'! +!PPMemento commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPMemento methodsFor: 'accessing-readonly' stamp: 'KenD 28/Jun/2026 13:27:39'! +count + ^ count +! ! + +!PPMemento methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:39'! +increment + count := count + 1 +! ! + +!PPMemento methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + count := 0 + +! ! + +!PPMemento methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +position + ^ position +! ! + +!PPMemento methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +position: anInteger + position := anInteger +! ! + +!PPMemento methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +result + ^ result +! ! + +!PPMemento methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +result: anObject + result := anObject +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPMemento class' category: #PetitParser! +PPMemento class + instanceVariableNames: ''! + + +PPMemento initialize! + diff --git a/modules/PetitParser/PPStream.Class.st b/modules/PetitParser/PPStream.Class.st new file mode 100644 index 00000000..5b187fe0 --- /dev/null +++ b/modules/PetitParser/PPStream.Class.st @@ -0,0 +1,78 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPStream category: #PetitParser! +InternalReadStream subclass: #PPStream + instanceVariableNames: 'failure' + classVariableNames: '' + poolDictionaries: '' + category: 'PetitParser'! +!PPStream commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPStream methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asPetitStream + ^ self +! ! + +!PPStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +failure + ^failure +! ! + +!PPStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +failure: aPPFailure + (failure isNil or: [failure position < aPPFailure position]) + ifTrue: [failure := aPPFailure] +! ! + +!PPStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +next: anInteger + | answer endPosition | + endPosition := position + anInteger min: limit. + answer := contents copyFrom: position + 1 to: endPosition. + position := endPosition. + ^answer +! ! + +!PPStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +peek + " + An improved version of peek, that is slightly faster than the built in version. + " + ^self atEnd ifFalse: [contents at: position + 1] +! ! + +!PPStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +position: anInteger + "The receiver does not check for invalid arguments passed to this method, as it is solely used with valid indexes for backtracking." + + position := anInteger +! ! + +!PPStream methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream + nextPutAll: (contents copyFrom: 1 to: position); + nextPutAll: 'ꞈ'; + nextPutAll: (contents copyFrom: position + 1 to: limit) +! ! + +!PPStream methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +uncheckedPeek + " + An unchecked version of peek that throws an error if we try to peek over the end of the stream, even faster than #peek. + " + ^contents at: position + 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPStream class' category: #PetitParser! +PPStream class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/PPToken.Class.st b/modules/PetitParser/PPToken.Class.st new file mode 100644 index 00000000..edca9e9d --- /dev/null +++ b/modules/PetitParser/PPToken.Class.st @@ -0,0 +1,140 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPToken category: #PetitParser! +Object subclass: #PPToken + instanceVariableNames: 'collection start stop' + classVariableNames: '' + poolDictionaries: '' + category: 'PetitParser'! +!PPToken commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPToken methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! += anObject + ^ self class = anObject class and: [ self value = anObject value ] +! ! + +!PPToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +collection + "Answer the underlying collection of this token." + + ^ collection +! ! + +!PPToken methodsFor: 'querying' stamp: 'KenD 28/Jun/2026 13:27:39'! +column + "Answer the column number of this token in the underlying collection." + + | position | + position := 0. + (self newline , [ :stream | + start <= stream position + ifTrue: [ ^ start - position ]. + position := stream position ] asParser + / #any asParser) star + parse: collection. + ^ start - position +! ! + +!PPToken methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyFrom: aStartInteger to: aStopInteger + ^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3 +! ! + +!PPToken methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hash + ^ self value hash +! ! + +!PPToken methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger + collection := aSequenceableCollection. + start := aStartInteger. + stop := aStopInteger +! ! + +!PPToken methodsFor: 'querying' stamp: 'KenD 28/Jun/2026 13:27:39'! +line + "Answer the line number of this token in the underlying collection." + + | line | + line := 1. + (self newline , [ :stream | + start <= stream position + ifTrue: [ ^ line ]. + line := line + 1 ] asParser + / #any asParser) star + parse: collection. + ^ line +! ! + +!PPToken methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +newline + "Parser a platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple." + + ^ (Character lf asParser) + / (Character cr asParser , Character lf asParser optional) +! ! + +!PPToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + super printOn: aStream. + aStream nextPut: $(; nextPutAll: self value; nextPut: $) +! ! + +!PPToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +size + "Answer the size of this token." + + ^ stop - start + 1 +! ! + +!PPToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +start + "Answer the start position of this token in the underlying collection." + + ^ start +! ! + +!PPToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +stop + "Answer the stop position of this token in the underlying collection." + + ^ stop +! ! + +!PPToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +value + "Answer the contents of this token." + + ^ collection copyFrom: start to: stop +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPToken class' category: #PetitParser! +PPToken class + instanceVariableNames: ''! + +!PPToken class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + self error: 'Token can only be created using a dedicated constructor.' +! ! + +!PPToken class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aSequenceableCollection + ^ self on: aSequenceableCollection start: 1 stop: aSequenceableCollection size +! ! + +!PPToken class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aSequenceableCollection start: aStartInteger stop: aStopInteger + ^ self basicNew + initializeOn: aSequenceableCollection + start: aStartInteger stop: aStopInteger +! ! + + diff --git a/modules/PetitParser/Parsers/PPActionParser.Class.st b/modules/PetitParser/Parsers/PPActionParser.Class.st new file mode 100644 index 00000000..3f83d2bc --- /dev/null +++ b/modules/PetitParser/Parsers/PPActionParser.Class.st @@ -0,0 +1,54 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPActionParser category: #Parsers! +PPDelegateParser subclass: #PPActionParser + instanceVariableNames: 'block' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPActionParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPActionParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +block + "Answer the action block of the receiver." + + ^ block +! ! + +!PPActionParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | element | + ^ (element := parser parseOn: aStream) isPetitFailure + ifFalse: [ block value: element ] + ifTrue: [ element ] +! ! + +!PPActionParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parser printSmalltalkReceiverOn: rtf. + rtf cr; cr; nextPutAll: '==> '. + block printSmalltalkReceiverOn: rtf +! ! + +!PPActionParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +setBlock: aBlock + block := aBlock +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPActionParser class' category: #Parsers! +PPActionParser class + instanceVariableNames: ''! + +!PPActionParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aParser block: aBlock + ^ (self on: aParser) setBlock: aBlock +! ! + + diff --git a/modules/PetitParser/Parsers/PPAndParser.Class.st b/modules/PetitParser/Parsers/PPAndParser.Class.st new file mode 100644 index 00000000..96fad423 --- /dev/null +++ b/modules/PetitParser/Parsers/PPAndParser.Class.st @@ -0,0 +1,42 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPAndParser category: #Parsers! +PPDelegateParser subclass: #PPAndParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPAndParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPAndParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +and + ^ self +! ! + +!PPAndParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | element position | + position := aStream position. + element := parser parseOn: aStream. + aStream position: position. + ^ element +! ! + +!PPAndParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parser printSmalltalkReceiverOn: rtf. + rtf nextPutAll: ' and' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPAndParser class' category: #Parsers! +PPAndParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPCharSetPredicate.Class.st b/modules/PetitParser/Parsers/PPCharSetPredicate.Class.st new file mode 100644 index 00000000..9f8bc902 --- /dev/null +++ b/modules/PetitParser/Parsers/PPCharSetPredicate.Class.st @@ -0,0 +1,47 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPCharSetPredicate category: #Parsers! +Object subclass: #PPCharSetPredicate + instanceVariableNames: 'block classification' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPCharSetPredicate commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPCharSetPredicate methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeOn: aBlock + block := aBlock. + classification := Array new: 255. + 1 to: classification size do: [ :index | + classification at: index put: (block + value: (Character value: index)) ] +! ! + +!PPCharSetPredicate methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:39'! +value: aCharacter + | index | + index := aCharacter asInteger. + index == 0 + ifTrue: [ ^ block value: aCharacter ]. + index > 255 + ifTrue: [ ^ block value: aCharacter ]. + ^ classification at: index +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPCharSetPredicate class' category: #Parsers! +PPCharSetPredicate class + instanceVariableNames: ''! + +!PPCharSetPredicate class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aBlock + ^ self basicNew initializeOn: aBlock +! ! + + diff --git a/modules/PetitParser/Parsers/PPChoiceParser.Class.st b/modules/PetitParser/Parsers/PPChoiceParser.Class.st new file mode 100644 index 00000000..e1838e3e --- /dev/null +++ b/modules/PetitParser/Parsers/PPChoiceParser.Class.st @@ -0,0 +1,43 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPChoiceParser category: #Parsers! +PPListParser subclass: #PPChoiceParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPChoiceParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPChoiceParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +/ aRule + ^ self copyWith: aRule +! ! + +!PPChoiceParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | element | + 1 to: parsers size do: [:index | + element := (parsers at: index) parseOn: aStream. + element isPetitFailure ifFalse: [^element]]. + ^element +! ! + +!PPChoiceParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parsers + do: [:p | p printSmalltalkReceiverOn: rtf] + separatedBy: [rtf nextPutAll: ' / '] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPChoiceParser class' category: #Parsers! +PPChoiceParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPDelegateParser.Class.st b/modules/PetitParser/Parsers/PPDelegateParser.Class.st new file mode 100644 index 00000000..7e3de2f5 --- /dev/null +++ b/modules/PetitParser/Parsers/PPDelegateParser.Class.st @@ -0,0 +1,42 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPDelegateParser category: #Parsers! +PPParser subclass: #PPDelegateParser + instanceVariableNames: 'parser' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPDelegateParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPDelegateParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +children + ^{parser} +! ! + +!PPDelegateParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + ^ parser parseOn: aStream +! ! + +!PPDelegateParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +setParser: aParser + parser := aParser +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPDelegateParser class' category: #Parsers! +PPDelegateParser class + instanceVariableNames: ''! + +!PPDelegateParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aParser + ^ self new setParser: aParser +! ! + + diff --git a/modules/PetitParser/Parsers/PPEndOfInputParser.Class.st b/modules/PetitParser/Parsers/PPEndOfInputParser.Class.st new file mode 100644 index 00000000..6cde4187 --- /dev/null +++ b/modules/PetitParser/Parsers/PPEndOfInputParser.Class.st @@ -0,0 +1,38 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPEndOfInputParser category: #Parsers! +PPDelegateParser subclass: #PPEndOfInputParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPEndOfInputParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPEndOfInputParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +end + ^ self +! ! + +!PPEndOfInputParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | position result | + position := aStream position. + result := parser parseOn: aStream. + (result isPetitFailure or: [aStream atEnd]) ifTrue: [^result]. + result := PPFailure message: 'end of input expected' from: aStream. + aStream position: position. + ^aStream failure +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPEndOfInputParser class' category: #Parsers! +PPEndOfInputParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPEpsilonParser.Class.st b/modules/PetitParser/Parsers/PPEpsilonParser.Class.st new file mode 100644 index 00000000..e65f84a0 --- /dev/null +++ b/modules/PetitParser/Parsers/PPEpsilonParser.Class.st @@ -0,0 +1,35 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPEpsilonParser category: #Parsers! +PPParser subclass: #PPEpsilonParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPEpsilonParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPEpsilonParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + ^ nil +! ! + +!PPEpsilonParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + rtf + useColor: PaintingVisitor new specialColor + while: [rtf nextPutAll: 'nil']. + rtf nextPutAll: ' asParser' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPEpsilonParser class' category: #Parsers! +PPEpsilonParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPFailingParser.Class.st b/modules/PetitParser/Parsers/PPFailingParser.Class.st new file mode 100644 index 00000000..bd225ff8 --- /dev/null +++ b/modules/PetitParser/Parsers/PPFailingParser.Class.st @@ -0,0 +1,50 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPFailingParser category: #Parsers! +PPParser subclass: #PPFailingParser + instanceVariableNames: 'message' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPFailingParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPFailingParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +message + "Answer the error message of the receiving parser." + + ^ message +! ! + +!PPFailingParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + ^PPFailure message: message from: aStream +! ! + +!PPFailingParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printNameOn: aStream + super printNameOn: aStream. + aStream nextPutAll: ', '; print: message +! ! + +!PPFailingParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +setMessage: aString + message := aString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPFailingParser class' category: #Parsers! +PPFailingParser class + instanceVariableNames: ''! + +!PPFailingParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +message: aString + ^ self new setMessage: aString +! ! + + diff --git a/modules/PetitParser/Parsers/PPFlattenParser.Class.st b/modules/PetitParser/Parsers/PPFlattenParser.Class.st new file mode 100644 index 00000000..dab56198 --- /dev/null +++ b/modules/PetitParser/Parsers/PPFlattenParser.Class.st @@ -0,0 +1,45 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPFlattenParser category: #Parsers! +PPDelegateParser subclass: #PPFlattenParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPFlattenParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPFlattenParser methodsFor: 'hooks' stamp: 'KenD 28/Jun/2026 13:27:39'! +create: aCollection start: aStartInteger stop: aStopInteger + ^ aCollection copyFrom: aStartInteger to: aStopInteger +! ! + +!PPFlattenParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | start element stop | + start := aStream position. + element := parser parseOn: aStream. + element isPetitFailure ifTrue: [ + aStream position: start. + ^ element ]. + stop := aStream position. + ^ self create: aStream collection start: start + 1 stop: stop +! ! + +!PPFlattenParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parser printSmalltalkReceiverOn: rtf. + rtf nextPutAll: ' flatten' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPFlattenParser class' category: #Parsers! +PPFlattenParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPListParser.Class.st b/modules/PetitParser/Parsers/PPListParser.Class.st new file mode 100644 index 00000000..43c0cd4b --- /dev/null +++ b/modules/PetitParser/Parsers/PPListParser.Class.st @@ -0,0 +1,66 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPListParser category: #Parsers! +PPParser subclass: #PPListParser + instanceVariableNames: 'parsers' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPListParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPListParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +children + ^ parsers +! ! + +!PPListParser methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:39'! +copyWith: aParser + ^ self species withAll: (parsers copyWith: aParser) +! ! + +!PPListParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + self setParsers: #() +! ! + +!PPListParser methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:39'! +postCopy + super postCopy. + parsers := parsers copy +! ! + +!PPListParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +setParsers: aCollection + parsers := aCollection asArray +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPListParser class' category: #Parsers! +PPListParser class + instanceVariableNames: ''! + +!PPListParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +with: aParser + ^self withAll: {aParser} +! ! + +!PPListParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +with: aFirstParser with: aSecondParser + ^self withAll: {aFirstParser. aSecondParser} +! ! + +!PPListParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +withAll: aCollection + ^ self basicNew setParsers: aCollection +! ! + + +PPListParser initialize! + diff --git a/modules/PetitParser/Parsers/PPLiteralObjectParser.Class.st b/modules/PetitParser/Parsers/PPLiteralObjectParser.Class.st new file mode 100644 index 00000000..e24e2a36 --- /dev/null +++ b/modules/PetitParser/Parsers/PPLiteralObjectParser.Class.st @@ -0,0 +1,37 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPLiteralObjectParser category: #Parsers! +PPLiteralParser subclass: #PPLiteralObjectParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPLiteralObjectParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPLiteralObjectParser methodsFor: 'operators' stamp: 'KenD 28/Jun/2026 13:27:39'! +caseInsensitive + "Answer a parser that can parse the receiver case-insensitive." + + literal asUppercase = literal asLowercase ifTrue: [ ^ self ]. + ^ PPPredicateObjectParser on: [ :value | literal sameAs: value ] message: message +! ! + +!PPLiteralObjectParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + ^(aStream atEnd not and: [aStream uncheckedPeek = literal]) + ifFalse: [PPFailure message: message from: aStream] + ifTrue: [aStream next] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPLiteralObjectParser class' category: #Parsers! +PPLiteralObjectParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPLiteralParser.Class.st b/modules/PetitParser/Parsers/PPLiteralParser.Class.st new file mode 100644 index 00000000..98529e1d --- /dev/null +++ b/modules/PetitParser/Parsers/PPLiteralParser.Class.st @@ -0,0 +1,78 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPLiteralParser category: #Parsers! +PPParser subclass: #PPLiteralParser + instanceVariableNames: 'literal message' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPLiteralParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPLiteralParser methodsFor: 'operators' stamp: 'KenD 28/Jun/2026 13:27:39'! +caseInsensitive + "Answer a parser that can parse the receiver case-insensitive." + + self subclassResponsibility +! ! + +!PPLiteralParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeOn: anObject message: aString + literal := anObject. + message := aString +! ! + +!PPLiteralParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +literal + "Answer the parsed literal." + + ^ literal +! ! + +!PPLiteralParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +message + "Answer the failure message." + + ^ message +! ! + +!PPLiteralParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printNameOn: aStream + super printNameOn: aStream. + aStream nextPutAll: ', '. + literal storeOn: aStream +! ! + +!PPLiteralParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + literal literalString printOn: aStream. + aStream nextPutAll: ' asParser' +! ! + +!PPLiteralParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + literal literalString printTextOn: rtf. + rtf nextPutAll: ' asParser' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPLiteralParser class' category: #Parsers! +PPLiteralParser class + instanceVariableNames: ''! + +!PPLiteralParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: anObject + ^ self on: anObject message: anObject printString , ' expected' +! ! + +!PPLiteralParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: anObject message: aString + ^ self new initializeOn: anObject message: aString +! ! + + diff --git a/modules/PetitParser/Parsers/PPLiteralSequenceParser.Class.st b/modules/PetitParser/Parsers/PPLiteralSequenceParser.Class.st new file mode 100644 index 00000000..553c0dcc --- /dev/null +++ b/modules/PetitParser/Parsers/PPLiteralSequenceParser.Class.st @@ -0,0 +1,53 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPLiteralSequenceParser category: #Parsers! +PPLiteralParser subclass: #PPLiteralSequenceParser + instanceVariableNames: 'size' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPLiteralSequenceParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPLiteralSequenceParser methodsFor: 'operators' stamp: 'KenD 28/Jun/2026 13:27:39'! +caseInsensitive + "Answer a parser that can parse the receiver case-insensitive." + + literal asUppercase = literal asLowercase ifTrue: [ ^ self ]. + ^ PPPredicateSequenceParser on: [ :value | literal sameAs: value ] message: message size: size +! ! + +!PPLiteralSequenceParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeOn: anObject message: aString + super initializeOn: anObject message: aString. + size := literal size +! ! + +!PPLiteralSequenceParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | position result | + position := aStream position. + result := aStream next: size. + result = literal ifTrue: [^result]. + aStream position: position. + ^PPFailure message: message from: aStream +! ! + +!PPLiteralSequenceParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +size + "Answer the sequence size of the receiver." + + ^ size +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPLiteralSequenceParser class' category: #Parsers! +PPLiteralSequenceParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPMappedParser.Class.st b/modules/PetitParser/Parsers/PPMappedParser.Class.st new file mode 100644 index 00000000..6a7ad04f --- /dev/null +++ b/modules/PetitParser/Parsers/PPMappedParser.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPMappedParser category: #Parsers! +PPListParser subclass: #PPMappedParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPMappedParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPMappedParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: key put: aPPParser + parsers at: key put: aPPParser +! ! + +!PPMappedParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + parsers := Dictionary new +! ! + +!PPMappedParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | key parser | + key := aStream peek. + key isNil + ifTrue: [^PPFailure + message: 'no parser for key ' , key printString + from: aStream]. + parser := parsers + at: key + ifAbsent: [^PPFailure + message: 'no parser for key ' , key printString + from: aStream]. + ^parser parseOn: aStream +! ! + +!PPMappedParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +setParsers: aDictionary + parsers := aDictionary +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPMappedParser class' category: #Parsers! +PPMappedParser class + instanceVariableNames: ''! + + +PPMappedParser initialize! + diff --git a/modules/PetitParser/Parsers/PPMemoizedParser.Class.st b/modules/PetitParser/Parsers/PPMemoizedParser.Class.st new file mode 100644 index 00000000..c5c7aa57 --- /dev/null +++ b/modules/PetitParser/Parsers/PPMemoizedParser.Class.st @@ -0,0 +1,60 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPMemoizedParser category: #Parsers! +PPDelegateParser subclass: #PPMemoizedParser + instanceVariableNames: 'stream buffer' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPMemoizedParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPMemoizedParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +memoized + "Ther is no point in memoizing more than once." + + ^ self +! ! + +!PPMemoizedParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | memento | + stream == aStream ifFalse: [self reset: aStream]. + memento := (buffer at: stream position + 1) + ifNil: [buffer at: stream position + 1 put: PPMemento new]. + memento position isNil + ifTrue: [ + memento + result: (stream size - stream position + 2 < memento count + ifTrue: [PPFailure message: 'overflow' from: stream] + ifFalse: [ + memento increment. + parser parseOn: stream]). + memento position: stream position] + ifFalse: [stream position: memento position]. + ^memento result +! ! + +!PPMemoizedParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + self printSmalltalkReceiverOn: rtf. + parser nextPutAll: ' memoized' +! ! + +!PPMemoizedParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +reset: aStream + stream := aStream. + buffer := Array new: aStream size + 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPMemoizedParser class' category: #Parsers! +PPMemoizedParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPNotParser.Class.st b/modules/PetitParser/Parsers/PPNotParser.Class.st new file mode 100644 index 00000000..c4498a8d --- /dev/null +++ b/modules/PetitParser/Parsers/PPNotParser.Class.st @@ -0,0 +1,37 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPNotParser category: #Parsers! +PPDelegateParser subclass: #PPNotParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPNotParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPNotParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | element position | + position := aStream position. + element := parser parseOn: aStream. + aStream position: position. + ^element isPetitFailure ifFalse: [PPFailure message: '' from: aStream] +! ! + +!PPNotParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parser printSmalltalkReceiverOn: rtf. + rtf nextPutAll: ' not' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPNotParser class' category: #Parsers! +PPNotParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPOptionalParser.Class.st b/modules/PetitParser/Parsers/PPOptionalParser.Class.st new file mode 100644 index 00000000..ec651689 --- /dev/null +++ b/modules/PetitParser/Parsers/PPOptionalParser.Class.st @@ -0,0 +1,35 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPOptionalParser category: #Parsers! +PPDelegateParser subclass: #PPOptionalParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPOptionalParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPOptionalParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | element | + element := parser parseOn: aStream. + ^ element isPetitFailure ifFalse: [ ^ element ] +! ! + +!PPOptionalParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parser printSmalltalkReceiverOn: rtf. + rtf nextPutAll: ' optional' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPOptionalParser class' category: #Parsers! +PPOptionalParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPParser.Class.st b/modules/PetitParser/Parsers/PPParser.Class.st new file mode 100644 index 00000000..de81f29a --- /dev/null +++ b/modules/PetitParser/Parsers/PPParser.Class.st @@ -0,0 +1,556 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPParser category: #Parsers! +Object subclass: #PPParser + instanceVariableNames: 'properties' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +& aParser + ^PPSequencedChoiceParser with: self with: aParser +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +, aParser + "Answer a new parser that parses the receiver followed by aParser." + + ^ PPSequenceParser with: self with: aParser +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +/ aParser + "Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)." + + ^ PPChoiceParser with: self with: aParser +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +| aParser + "Answer a new parser that either parses the receiver or aParser. Fail if both pass or fail (exclusive choice, unordered choice)." + + ^ (self not , aParser) / (aParser not , self) ==> #second +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +==> aBlock + "Answer a new parser that performs aBlock as action handler on success." + + ^ PPActionParser on: self block: aBlock +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +>=> aBlock + "Answer a new parser that wraps the receiving parser with a two argument block. The first argument is the parsed stream, the second argument a continuation block on the delegate parser." + + ^ PPWrappingParser on: self block: aBlock +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +and + "Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input." + + ^ PPAndParser on: self +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +answer: anObject + "Answer a new parser that always returns anObject from a successful parse." + + ^ self ==> [ :nodes | anObject ] +! ! + +!PPParser methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asParser + ^ self +! ! + +!PPParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +children + "Answer a set of child parsers that could follow the receiver." + + ^ #() +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +def: aParser + "Redefine the receiver as the argument aParser. This method is useful when defining recursive parsers: instantiate a PPParser and later redefine it with another one." + + ^ self become: (aParser name: self name) +! ! + +!PPParser methodsFor: 'operations-convenience' stamp: 'KenD 28/Jun/2026 13:27:39'! +delimitedBy: aParser + "Answer a new parser that parses the receiver one or more times, separated and possibly ended by aParser." + + ^ (self separatedBy: aParser) , (aParser optional) ==> [ :node | + node second isNil + ifTrue: [ node first ] + ifFalse: [ node first copyWith: node second ] ] +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +end + "Answer a new parser that succeeds at the end of the input and return the result of the receiver." + + ^ PPEndOfInputParser on: self +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +flatten + "Answer a new parser that flattens the underlying collection." + + ^ PPFlattenParser on: self +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +foldLeft: aBlock + "Answer a new parser that that folds the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments." + + | size args | + size := aBlock numArgs. + args := Array new: size. + ^ self ==> [ :nodes | + args at: 1 put: (nodes at: 1). + 2 to: nodes size by: size - 1 do: [ :index | + args + replaceFrom: 2 to: size with: nodes startingAt: index; + at: 1 put: (aBlock valueWithArguments: args) ]. + args at: 1 ] +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +foldRight: aBlock + "Answer a new parser that that folds the result of the receiver from right-to-left into aBlock. The argument aBlock must take two or more arguments." + + | size args | + size := aBlock numArgs. + args := Array new: size. + ^ self ==> [ :nodes | + args at: size put: (nodes at: nodes size). + nodes size - size + 1 to: 1 by: 1 - size do: [ :index | + args + replaceFrom: 1 to: size - 1 with: nodes startingAt: index; + at: size put: (aBlock valueWithArguments: args) ]. + args at: size ] +! ! + +!PPParser methodsFor: 'accessing-properties' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasProperty: aKey + "Test if the property aKey is present." + + ^ properties notNil and: [ properties includesKey: aKey ] +! ! + +!PPParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + +! ! + +!PPParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPetitParser + ^ true +! ! + +!PPParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUnresolved + ^ false +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +map: aBlock + "Answer a new parser that works on the receiving sequence an passes in each element as a block argument." + + ^ self ==> aBlock +! ! + +!PPParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +matches: anObject + "Answer if anObject can be parsed by the receiver." + + ^ (self parse: anObject) isPetitFailure not +! ! + +!PPParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +matchesIn: anObject + "Search anObject repeatedly for the matches of the receiver." + + | result | + result := OrderedCollection new. + self + matchesIn: anObject + do: [ :each | result addLast: each ]. + ^ result +! ! + +!PPParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +matchesIn: anObject do: aBlock + "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Make sure to always consume exactly one character with each step, to not miss any match." + + ((self and ==> aBlock , #any asParser) / #any asParser) star parse: anObject +! ! + +!PPParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +matchingRangesIn: anObject + "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)." + + | result | + result := OrderedCollection new. + [ :stream | stream position + 1 ] asParser , self , [ :stream | stream position ] asParser + matchesIn: anObject + do: [ :value | result addLast: (value first to: value last) ]. + ^ result +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +max: anInteger + "Answer a new parser that parses the receiver at most anInteger times." + + ^ PPRepeatingParser on: self max: anInteger +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +memoized + "Answer a new memoized parser, for refraining redundant computations. This ensures polynomial time O(n^4) for left-recursive grammars and O(n^3) for non left-recursive grammars in the worst case. Not necessary for most grammars that are carefully written and in O(n) anyway." + + ^ PPMemoizedParser on: self +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +min: anInteger + "Answer a new parser that parses the receiver at least anInteger times." + + ^ PPRepeatingParser on: self min: anInteger +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +min: aMinInteger max: aMaxInteger + "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times." + + ^ PPRepeatingParser on: self min: aMinInteger max: aMaxInteger +! ! + +!PPParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + "Answer the production name of the receiver." + + ^ self propertyAt: #name ifAbsent: [ nil ] +! ! + +!PPParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aString + self propertyAt: #name put: aString +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +negate + "Answer a new parser consumes any input token but the receiver." + + ^ self not , #any asParser ==> #second +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +newline + ^Character lf asParser + / (Character cr asParser , Character lf asParser optional) + ==> [:nodes | + (nodes size = 2 and: [nodes last isNil]) + ifTrue: [nodes first] + ifFalse: [nodes]] +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +not + "Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input." + + ^ PPNotParser on: self +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +optional + "Answer a new parser that parses the receiver, if possible." + + ^ PPOptionalParser on: self +! ! + +!PPParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parse: anObject + | stream result | + stream := anObject asPetitStream. + result := self parseOn: stream. + result isPetitFailure ifTrue: [^stream failure ifNil: [result]]. + ^result +! ! + +!PPParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parse: anObject onError: aBlock + "Parse anObject with the receiving parser and answer the parse-result or answer the result of evaluating aBlock. Depending on the number of arguments of the block it is simply evaluated, evaluated with the failure object, or evaluated with the error message and position." + + | result | + result := self parseOn: anObject asPetitStream. + result isPetitFailure + ifFalse: [ ^ result ]. + aBlock numArgs = 0 + ifTrue: [ ^ aBlock value ]. + aBlock numArgs = 1 + ifTrue: [ ^ aBlock value: result ]. + ^ aBlock value: result message value: result position +! ! + +!PPParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + "Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:." + + self subclassResponsibility +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +plus + "Answer a new parser that parses the receiver one or more times." + + ^ self min: 1 +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +plusGreedy: aParser + "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed." + + ^ self , (self starGreedy: aParser) map: [ :first :rest | rest copyWithFirst: first ] +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +plusLazy: aParser + "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed." + + ^ self , (self starLazy: aParser) map: [ :first :rest | rest copyWithFirst: first ] +! ! + +!PPParser methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:39'! +postCopy + super postCopy. + properties := properties copy +! ! + +!PPParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printNameOn: aStream + self name isNil + ifTrue: [ aStream print: self hash ] + ifFalse: [ aStream nextPutAll: self name ] +! ! + +!PPParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + super printOn: aStream. + aStream nextPut: $(. + self printNameOn: aStream. + aStream nextPut: $) +! ! + +!PPParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printSmalltalkReceiverOn: rtf + | text ast | + text := Rtf new. + self printTextOn: text. + ast := SmalltalkParser new parseSnippet: '(' , text asString , ') msg'. + (ast isNil or: [ast format trimBlanks first = $(]) + ifTrue: [ + rtf nextPut: $(. + self printTextOn: rtf. + rtf nextPut: $)] + ifFalse: [self printTextOn: rtf] +! ! + +!PPParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + | signature class | + signature := self signature ifNil: [^super printTextOn: rtf]. + class := signature key classImplementing: signature value. + class >> signature value printTextOn: rtf +! ! + +!PPParser methodsFor: 'accessing-properties' stamp: 'KenD 28/Jun/2026 13:27:39'! +propertyAt: aKey + "Answer the property value associated with aKey." + + ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ] +! ! + +!PPParser methodsFor: 'accessing-properties' stamp: 'KenD 28/Jun/2026 13:27:39'! +propertyAt: aKey ifAbsent: aBlock + "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." + + ^ properties isNil + ifTrue: [ aBlock value ] + ifFalse: [ properties at: aKey ifAbsent: aBlock ] +! ! + +!PPParser methodsFor: 'accessing-properties' stamp: 'KenD 28/Jun/2026 13:27:39'! +propertyAt: aKey ifAbsentPut: aBlock + "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." + + ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ] +! ! + +!PPParser methodsFor: 'accessing-properties' stamp: 'KenD 28/Jun/2026 13:27:39'! +propertyAt: aKey put: anObject + "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." + + ^ (properties ifNil: [ properties := Dictionary new: 1 ]) + at: aKey put: anObject +! ! + +!PPParser methodsFor: 'accessing-properties' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeProperty: aKey + "Remove the property with aKey. Answer the property or raise an error if aKey isn't found." + + ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ] +! ! + +!PPParser methodsFor: 'accessing-properties' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeProperty: aKey ifAbsent: aBlock + " + Remove the property with aKey. Answer the value or, if aKey isn't found, answer + the result of evaluating aBlock. + " + | assoc | + properties isNil ifTrue: [^aBlock value]. + assoc := properties associationAt: aKey ifAbsent: [^aBlock value]. + properties removeKey: aKey. + properties isEmpty ifTrue: [properties := nil]. + ^assoc value +! ! + +!PPParser methodsFor: 'operations-convenience' stamp: 'KenD 28/Jun/2026 13:27:39'! +separatedBy: aParser + "Answer a new parser that parses the receiver one or more times, separated by aParser." + + ^ (PPSequenceParser with: self with: (PPSequenceParser with: aParser with: self) star) ==> [ :nodes | + | result | + result := Array new: 2 * nodes second size + 1. + result at: 1 put: nodes first. + nodes second + keysAndValuesDo: [ :index :pair | result replaceFrom: 2 * index to: 2 * index + 1 with: pair startingAt: 1 ]. + result ] +! ! + +!PPParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +signature + ^self propertyAt: #signature ifAbsent: nil +! ! + +!PPParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +signature: anAssociation + self + propertyAt: #signature put: anAssociation; + name: anAssociation value +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +star + "Answer a new parser that parses the receiver zero or more times. This is a greedy and blind implementation that tries to consume as much input as possible and it does not consider what comes afterwards." + + ^ PPRepeatingParser on: self +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +starGreedy: aParser + " + Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed. + " + | parser | + parser := PPChoiceParser new. + parser + setParsers: {self , parser + map: [:each :rest | rest addFirst: each; yourself]. + aParser and ==> [:each | OrderedCollection new]}. + ^parser ==> [:rest | rest asArray] +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +starLazy: aParser + " + Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed. + " + | parser | + parser := PPChoiceParser new. + parser + setParsers: {aParser and ==> [:each | OrderedCollection new]. + self , parser map: [:each :rest | rest addFirst: each; yourself]}. + ^parser ==> [:rest | rest asArray] +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +times: anInteger + "Answer a new parser that parses the receiver exactly anInteger times." + + ^ self min: anInteger max: anInteger +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +token + "Answer a new parser that transforms the input to a token." + + ^ PPTokenParser on: self +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +token: aTokenClass + "Answer a new parser that transforms the input to a token of class aTokenClass." + + ^ self token tokenClass: aTokenClass +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +trim + "Answer a new parser that consumes spaces before and after the receiving parser." + + ^ self trimSpaces +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +trimBlanks + "Answer a new parser that consumes blanks before and after the receiving parser." + + ^ PPTrimmingParser on: self trimmer: #blank asParser +! ! + +!PPParser methodsFor: 'operations-mapping' stamp: 'KenD 28/Jun/2026 13:27:39'! +trimSpaces + "Answer a new parser that consumes spaces before and after the receiving parser." + + ^ PPTrimmingParser on: self trimmer: #space asParser +! ! + +!PPParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +wrapped + "Answer a new parser that is simply wrapped." + + ^ PPDelegateParser on: self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPParser class' category: #Parsers! +PPParser class + instanceVariableNames: ''! + +!PPParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +named: aString + ^ self new name: aString +! ! + +!PPParser class methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parse: anObject for: requestor + ^self parse: anObject +! ! + + +PPParser initialize! + diff --git a/modules/PetitParser/Parsers/PPPluggableParser.Class.st b/modules/PetitParser/Parsers/PPPluggableParser.Class.st new file mode 100644 index 00000000..3a5eabc1 --- /dev/null +++ b/modules/PetitParser/Parsers/PPPluggableParser.Class.st @@ -0,0 +1,49 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPPluggableParser category: #Parsers! +PPParser subclass: #PPPluggableParser + instanceVariableNames: 'block' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPPluggableParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPPluggableParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +block + "Answer the pluggable block." + + ^ block +! ! + +!PPPluggableParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeOn: aBlock + block := aBlock +! ! + +!PPPluggableParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | position result | + position := aStream position. + result := block value: aStream. + result isPetitFailure + ifTrue: [ aStream position: position ]. + ^ result +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPPluggableParser class' category: #Parsers! +PPPluggableParser class + instanceVariableNames: ''! + +!PPPluggableParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aBlock + ^ self new initializeOn: aBlock +! ! + + diff --git a/modules/PetitParser/Parsers/PPPredicateObjectParser.Class.st b/modules/PetitParser/Parsers/PPPredicateObjectParser.Class.st new file mode 100644 index 00000000..5d2a9956 --- /dev/null +++ b/modules/PetitParser/Parsers/PPPredicateObjectParser.Class.st @@ -0,0 +1,272 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPPredicateObjectParser category: #Parsers! +PPPredicateParser subclass: #PPPredicateObjectParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPPredicateObjectParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPPredicateObjectParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString + predicate := aBlock. + predicateMessage := aString. + negated := aNegatedBlock. + negatedMessage := aNegatedString +! ! + +!PPPredicateObjectParser methodsFor: 'operators' stamp: 'KenD 28/Jun/2026 13:27:39'! +negate + " + Answer a parser that is the negation of the receiving predicate parser. + " + | parser name | + parser := self class + on: negated + message: negatedMessage + negated: predicate + message: predicateMessage. + name := self name ifNil: [^parser]. + ^parser name: name , ' negate' +! ! + +!PPPredicateObjectParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + ^(aStream atEnd not and: [predicate value: aStream uncheckedPeek]) + ifFalse: [PPFailure message: predicateMessage from: aStream] + ifTrue: [aStream next] +! ! + +!PPPredicateObjectParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + self name isSymbol + ifTrue: [ + self name storeOn: aStream. + aStream nextPutAll: ' asParser'] + ifFalse: [super printOn: aStream] +! ! + +!PPPredicateObjectParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + self name isSymbol + ifTrue: [ + self name printTextOn: rtf. + rtf nextPutAll: ' asParser'] + ifFalse: [super printTextOn: rtf] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPPredicateObjectParser class' category: #Parsers! +PPPredicateObjectParser class + instanceVariableNames: ''! + +!PPPredicateObjectParser class methodsFor: 'factory-objects' stamp: 'KenD 28/Jun/2026 13:27:39'! +any + | parser | + parser := self + on: [:each | true] + message: 'input expected' + negated: [:each | false] + message: 'no input expected'. + ^parser name: #any +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-objects' stamp: 'KenD 28/Jun/2026 13:27:39'! +anyExceptAnyOf: aCollectionOfChars + ^self + on: [:each | (aCollectionOfChars includes: each) not] + message: 'any except ' , aCollectionOfChars printString , ' expected' + negated: [:each | aCollectionOfChars includes: each] + message: aCollectionOfChars printString , ' not expected' +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-objects' stamp: 'KenD 28/Jun/2026 13:27:39'! +anyOf: anArray + ^self + on: [:each | anArray includes: each] + message: 'any of ' , anArray printString , ' expected' + negated: [:each | (anArray includes: each) not] + message: 'none of ' , anArray printString , 'expected' +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-objects' stamp: 'KenD 28/Jun/2026 13:27:39'! +between: min and: max + ^ self + on: [ :each | each >= min and: [ each <= max ] ] message: min printString , '..' , max printString , ' expected' + negated: [ :each | each < min or: [ each > max ] ] message: min printString , '..' , max printString , ' not expected' +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +blank + | parser | + parser := self + chars: ((0 to: 32) collect: #asCharacter) + message: 'blank expected'. + ^parser name: #blank +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +char: aCharacter + | parser | + parser := self + expect: aCharacter + message: (String with: $" with: aCharacter with: $") , ' expected'. + ^parser name: aCharacter storeString +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +char: aCharacter message: aString + ^ self expect: aCharacter message: aString +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +chars: aCollection message: aString + ^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +cr + | parser | + parser := self char: Character cr message: 'carriage return expected'. + ^parser name: #cr +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +digit + | parser | + parser := self + on: (PPCharSetPredicate on: #isDigit) + message: 'digit expected'. + ^parser name: #digit +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-objects' stamp: 'KenD 28/Jun/2026 13:27:39'! +expect: anObject + ^ self expect: anObject message: anObject printString , ' expected' +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-objects' stamp: 'KenD 28/Jun/2026 13:27:39'! +expect: anObject message: aString + ^ self + on: [ :each | each = anObject ] message: aString + negated: [ :each | each ~= anObject ] message: 'no ' , aString +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +hex + | parser | + parser := self + on: (PPCharSetPredicate on: #isHexDigit) + message: 'hex digit expected'. + ^parser name: #hex +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +identifier + | parser | + parser := self + on: (PPCharSetPredicate on: [:char | char = $_ or: [char isAlphanumeric]]) + message: 'letter expected'. + ^parser name: #identifier +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +letter + | parser | + parser := self + on: (PPCharSetPredicate on: #isAsciiLetter) + message: 'letter expected'. + ^parser name: #letter +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +lf + | parser | + parser := self char: Character lf. + ^parser name: #lf +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +lowercase + | parser | + parser := self + on: (PPCharSetPredicate on: #isLowercase) + message: 'lowercase letter expected'. + ^parser name: #lowercase +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +newline + | parser | + parser := self + chars: (String with: Character cr with: Character lf) + message: 'newline expected'. + ^parser name: #newline +! ! + +!PPPredicateObjectParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aBlock message: aString + ^self + on: aBlock + message: aString + negated: [:each | (aBlock value: each) not] + message: 'no ' , aString +! ! + +!PPPredicateObjectParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aBlock message: aString negated: aNegatedBlock message: aNegatedString + ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +punctuation + | parser | + parser := self + chars: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~' + message: 'punctuation expected'. + ^parser name: #punctuation +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +space + | parser | + parser := self + on: (PPCharSetPredicate on: #isBlank) + message: 'separator expected'. + ^parser name: #space +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +tab + | parser | + parser := self char: Character tab message: 'tab expected'. + ^parser name: #tab +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +uppercase + | parser | + parser := self + on: (PPCharSetPredicate on: #isUppercase) + message: 'uppercase letter expected'. + ^parser name: 'uppercase' +! ! + +!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'KenD 28/Jun/2026 13:27:39'! +word + | parser | + parser := self + on: (PPCharSetPredicate + on: [:char | char isLetter or: [char isDigit] or: [char = $_]]) + message: 'letter or digit expected'. + ^parser name: #word +! ! + + diff --git a/modules/PetitParser/Parsers/PPPredicateParser.Class.st b/modules/PetitParser/Parsers/PPPredicateParser.Class.st new file mode 100644 index 00000000..65d5a71c --- /dev/null +++ b/modules/PetitParser/Parsers/PPPredicateParser.Class.st @@ -0,0 +1,42 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPPredicateParser category: #Parsers! +PPParser subclass: #PPPredicateParser + instanceVariableNames: 'predicate predicateMessage negated negatedMessage' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPPredicateParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPPredicateParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +block + "Answer the predicate block of the receiver." + + ^ predicate +! ! + +!PPPredicateParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +message + "Answer the failure message." + + ^ predicateMessage +! ! + +!PPPredicateParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printNameOn: aStream + super printNameOn: aStream. + aStream nextPutAll: ', '; print: predicateMessage +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPPredicateParser class' category: #Parsers! +PPPredicateParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPPredicateSequenceParser.Class.st b/modules/PetitParser/Parsers/PPPredicateSequenceParser.Class.st new file mode 100644 index 00000000..09c12327 --- /dev/null +++ b/modules/PetitParser/Parsers/PPPredicateSequenceParser.Class.st @@ -0,0 +1,78 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPPredicateSequenceParser category: #Parsers! +PPPredicateParser subclass: #PPPredicateSequenceParser + instanceVariableNames: 'size' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPPredicateSequenceParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPPredicateSequenceParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger + predicate := aBlock. + predicateMessage := aString. + negated := aNegatedBlock. + negatedMessage := aNegatedString. + size := anInteger +! ! + +!PPPredicateSequenceParser methodsFor: 'operators' stamp: 'KenD 28/Jun/2026 13:27:39'! +negate + "Answer a parser that is the negation of the receiving predicate parser." + + ^ self class + on: negated message: negatedMessage + negated: predicate message: predicateMessage + size: size +! ! + +!PPPredicateSequenceParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | position result | + position := aStream position. + result := aStream next: size. + (result size = size and: [predicate value: result]) ifTrue: [^result]. + aStream position: position. + ^PPFailure message: predicateMessage from: aStream +! ! + +!PPPredicateSequenceParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +size + "Answer the sequence size of the receiver." + + ^ size +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPPredicateSequenceParser class' category: #Parsers! +PPPredicateSequenceParser class + instanceVariableNames: ''! + +!PPPredicateSequenceParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger + ^self new + initializeOn: aBlock + message: aString + negated: aNegatedBlock + message: aNegatedString + size: anInteger +! ! + +!PPPredicateSequenceParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aBlock message: aString size: anInteger + ^self + on: aBlock + message: aString + negated: [:each | (aBlock value: each) not] + message: 'no ' , aString + size: anInteger +! ! + + diff --git a/modules/PetitParser/Parsers/PPRepeatingParser.Class.st b/modules/PetitParser/Parsers/PPRepeatingParser.Class.st new file mode 100644 index 00000000..e2f3cab0 --- /dev/null +++ b/modules/PetitParser/Parsers/PPRepeatingParser.Class.st @@ -0,0 +1,123 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPRepeatingParser category: #Parsers! +PPDelegateParser subclass: #PPRepeatingParser + instanceVariableNames: 'min max' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPRepeatingParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPRepeatingParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPlus + ^min = 1 and: [max = SmallInteger maximum] +! ! + +!PPRepeatingParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isStar + ^min = 0 and: [max = SmallInteger maximum] +! ! + +!PPRepeatingParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +max + "Answer the maximum number of repetitions." + + ^ max +! ! + +!PPRepeatingParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +min + "Answer the minimum number of repetitions." + + ^ min +! ! + +!PPRepeatingParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | start element elements | + start := aStream position. + elements := OrderedCollection new. + [ elements size < min ] whileTrue: [ + (element := parser parseOn: aStream) isPetitFailure ifTrue: [ + aStream position: start. + ^ element ]. + elements addLast: element ]. + [ elements size < max ] whileTrue: [ + (element := parser parseOn: aStream) isPetitFailure + ifTrue: [ ^ elements asArray ]. + elements addLast: element ]. + ^ elements asArray +! ! + +!PPRepeatingParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + self name ifNotNil: [^self printNameOn: aStream]. + aStream nextPut: $(. + parser printOn: aStream. + aStream nextPutAll: ') '. + self isStar ifTrue: [^aStream nextPutAll: 'star']. + self isPlus ifTrue: [^aStream nextPutAll: 'plus']. + aStream + nextPutAll: ' ['; + print: min; + nextPutAll: ', '; + nextPutAll: (max = SmallInteger maximum + ifTrue: ['*'] + ifFalse: [max printString]); + nextPut: $] +! ! + +!PPRepeatingParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + | stop | + self name ifNotNil: [^self printNameOn: rtf]. + parser printSmalltalkReceiverOn: rtf. + self isStar ifTrue: [^rtf nextPutAll: ' star']. + self isPlus ifTrue: [^rtf nextPutAll: ' plus']. + stop := max = SmallInteger maximum ifTrue: ['*'] ifFalse: [max printString]. + rtf + nextPutAll: ' rep ['; + print: min; + nextPutAll: ', '; + nextPutAll: stop; + nextPut: $] +! ! + +!PPRepeatingParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +setMin: aMinInteger max: aMaxInteger + min := aMinInteger. + max := aMaxInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPRepeatingParser class' category: #Parsers! +PPRepeatingParser class + instanceVariableNames: ''! + +!PPRepeatingParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aParser + ^(super on: aParser) setMin: 0 max: SmallInteger maximum +! ! + +!PPRepeatingParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aParser max: aMaxInteger + ^ (self on: aParser) setMin: 0 max: aMaxInteger +! ! + +!PPRepeatingParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aParser min: aMinInteger + ^(self on: aParser) setMin: aMinInteger max: SmallInteger maximum +! ! + +!PPRepeatingParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aParser min: aMinInteger max: aMaxInteger + ^ (self on: aParser) setMin: aMinInteger max: aMaxInteger +! ! + + diff --git a/modules/PetitParser/Parsers/PPSequenceParser.Class.st b/modules/PetitParser/Parsers/PPSequenceParser.Class.st new file mode 100644 index 00000000..514a1c4d --- /dev/null +++ b/modules/PetitParser/Parsers/PPSequenceParser.Class.st @@ -0,0 +1,66 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPSequenceParser category: #Parsers! +PPListParser subclass: #PPSequenceParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPSequenceParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPSequenceParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +, aRule + ^ self copyWith: aRule +! ! + +!PPSequenceParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +map: aBlock + ^ self ==> [ :nodes | aBlock valueWithArguments: nodes ] +! ! + +!PPSequenceParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + "This is optimized code that avoids unnecessary block activations, do not change." + + | start elements element | + start := aStream position. + elements := Array new: parsers size. + 1 to: parsers size do: [ :index | + element := (parsers at: index) + parseOn: aStream. + element isPetitFailure ifTrue: [ + aStream position: start. + ^ element ]. + elements at: index put: element ]. + ^ elements +! ! + +!PPSequenceParser methodsFor: 'permutation' stamp: 'KenD 28/Jun/2026 13:27:39'! +permutation: anArrayOfIntegers + "Answer a permutation of the receivers sequence." + + anArrayOfIntegers do: [ :index | + (index isInteger and: [ index between: 1 and: parsers size ]) + ifFalse: [ self error: 'Invalid permutation index: ' , index printString ] ]. + ^ self ==> [ :nodes | anArrayOfIntegers collect: [ :index | nodes at: index ] ] +! ! + +!PPSequenceParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parsers + do: [:p | p printSmalltalkReceiverOn: rtf] + separatedBy: [rtf nextPutAll: ' , '] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPSequenceParser class' category: #Parsers! +PPSequenceParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPSequencedChoiceParser.Class.st b/modules/PetitParser/Parsers/PPSequencedChoiceParser.Class.st new file mode 100644 index 00000000..cd07f4e1 --- /dev/null +++ b/modules/PetitParser/Parsers/PPSequencedChoiceParser.Class.st @@ -0,0 +1,51 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPSequencedChoiceParser category: #Parsers! +PPListParser subclass: #PPSequencedChoiceParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPSequencedChoiceParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPSequencedChoiceParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +& aRule + ^self copyWith: aRule +! ! + +!PPSequencedChoiceParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + " + This is optimized code that avoids unnecessary block activations, do not change. + When all choices fail, the last failure is answered. + " + | element elements start | + elements := Array new: parsers size. + start := aStream position. + 1 to: parsers size do: [:index | + element := (parsers at: index) parseOn: aStream. + element isPetitFailure ifFalse: [elements at: index put: element]]. + ^(elements anySatisfy: [:elem | elem notNil]) ifTrue: [elements] ifFalse: [ + aStream position: start. + PPFailure message: 'No match for any "and / or" rule' from: aStream] +! ! + +!PPSequencedChoiceParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parsers + do: [:p | p printSmalltalkReceiverOn: rtf] + separatedBy: [rtf nextPutAll: ' & '] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPSequencedChoiceParser class' category: #Parsers! +PPSequencedChoiceParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Parsers/PPTokenParser.Class.st b/modules/PetitParser/Parsers/PPTokenParser.Class.st new file mode 100644 index 00000000..b4084700 --- /dev/null +++ b/modules/PetitParser/Parsers/PPTokenParser.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPTokenParser category: #Parsers! +PPFlattenParser subclass: #PPTokenParser + instanceVariableNames: 'tokenClass' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPTokenParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPTokenParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +create: aCollection start: aStartInteger stop: aStopInteger + ^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger +! ! + +!PPTokenParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +defaultTokenClass + ^ PPToken +! ! + +!PPTokenParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + tokenClass := self defaultTokenClass + +! ! + +!PPTokenParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parser printSmalltalkReceiverOn: rtf. + rtf nextPutAll: ' token' +! ! + +!PPTokenParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +tokenClass + ^ tokenClass +! ! + +!PPTokenParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +tokenClass: aTokenClass + tokenClass := aTokenClass +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPTokenParser class' category: #Parsers! +PPTokenParser class + instanceVariableNames: ''! + + +PPTokenParser initialize! + diff --git a/modules/PetitParser/Parsers/PPTrimmingParser.Class.st b/modules/PetitParser/Parsers/PPTrimmingParser.Class.st new file mode 100644 index 00000000..6f805f52 --- /dev/null +++ b/modules/PetitParser/Parsers/PPTrimmingParser.Class.st @@ -0,0 +1,63 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPTrimmingParser category: #Parsers! +PPDelegateParser subclass: #PPTrimmingParser + instanceVariableNames: 'trimmer' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPTrimmingParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPTrimmingParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + | position element | + position := aStream position. + [ (trimmer parseOn: aStream) isPetitFailure ] + whileFalse. + element := parser parseOn: aStream. + element isPetitFailure ifTrue: [ + aStream position: position. + ^ element ]. + [ (trimmer parseOn: aStream) isPetitFailure ] + whileFalse. + ^ element +! ! + +!PPTrimmingParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parser printSmalltalkReceiverOn: rtf. + rtf nextPutAll: ' trim' +! ! + +!PPTrimmingParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +setTrimmer: aParser + trimmer := aParser +! ! + +!PPTrimmingParser methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:39'! +trim + "There is no point in trimming more than once." + + ^ self +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPTrimmingParser class' category: #Parsers! +PPTrimmingParser class + instanceVariableNames: ''! + +!PPTrimmingParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aParser trimmer: aTrimParser + ^ self new + setParser: aParser; + setTrimmer: aTrimParser; + yourself +! ! + + diff --git a/modules/PetitParser/Parsers/PPWrappingParser.Class.st b/modules/PetitParser/Parsers/PPWrappingParser.Class.st new file mode 100644 index 00000000..e8107dd3 --- /dev/null +++ b/modules/PetitParser/Parsers/PPWrappingParser.Class.st @@ -0,0 +1,36 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPWrappingParser category: #Parsers! +PPActionParser subclass: #PPWrappingParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Parsers'! +!PPWrappingParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPWrappingParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + ^ block value: aStream value: [ parser parseOn: aStream ] +! ! + +!PPWrappingParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printTextOn: rtf + parser printSmalltalkReceiverOn: rtf. + rtf + useColor: PaintingVisitor new defaultColor + while: [rtf nextPutAll: ' >=> ']. + block printTextOn: rtf +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPWrappingParser class' category: #Parsers! +PPWrappingParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/PetitParserModule.Class.st b/modules/PetitParser/PetitParserModule.Class.st new file mode 100644 index 00000000..0b3c018a --- /dev/null +++ b/modules/PetitParser/PetitParserModule.Class.st @@ -0,0 +1,22 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PetitParserModule category: #PetitParser! +Module subclass: #PetitParserModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'PetitParser'! +!PetitParserModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #Kernel -> #(#InternalReadStream) + } +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PetitParserModule class' category: #PetitParser! +PetitParserModule class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Tools/PPCompositeParser.Class.st b/modules/PetitParser/Tools/PPCompositeParser.Class.st new file mode 100644 index 00000000..ead49435 --- /dev/null +++ b/modules/PetitParser/Tools/PPCompositeParser.Class.st @@ -0,0 +1,122 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPCompositeParser category: #Tools! +PPDelegateParser subclass: #PPCompositeParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools'! +!PPCompositeParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPCompositeParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeStartingAt: aSymbol + | allVariableNames ignoredVariableNames productionIndexesAndNames | + self initialize. + + "find all the productions that need to be initialized" + allVariableNames := self class allInstVarNames + collect: [ :each | each asSymbol ]. + ignoredVariableNames := self class ignoredNames + collect: [ :each | each asSymbol ]. + productionIndexesAndNames := ((1 to: self class instSize) + collect: [ :index | index -> (allVariableNames at: index) ]) + reject: [ :assoc | ignoredVariableNames includes: assoc value ]. + + "initialize productions with an undefined parser to be replaced later" + parser := PPUnresolvedParser named: aSymbol. + productionIndexesAndNames do: [ :assoc | + self instVarAt: assoc key put: (PPUnresolvedParser named: assoc value) ]. + parser def: (self perform: aSymbol). + + "resolve unresolved parsers with their actual implementation" + productionIndexesAndNames do: [ :assoc | + (self respondsTo: assoc value) + ifFalse: [ self error: 'Unable to initialize ' , assoc value printString ] + ifTrue: [ (self instVarAt: assoc key) def: (self perform: assoc value) ] ] +! ! + +!PPCompositeParser methodsFor: 'querying' stamp: 'KenD 28/Jun/2026 13:27:39'! +productionAt: aSymbol + "Answer the production named aSymbol." + + ^ self productionAt: aSymbol ifAbsent: [ nil ] +! ! + +!PPCompositeParser methodsFor: 'querying' stamp: 'KenD 28/Jun/2026 13:27:39'! +productionAt: aSymbol ifAbsent: aBlock + "Answer the production named aSymbol, if there is no such production answer the result of evaluating aBlock." + + (self class ignoredNames includes: aSymbol asString) + ifTrue: [ ^ aBlock value ]. + (self class startSymbol = aSymbol) + ifTrue: [ ^ parser ]. + ^ self instVarAt: (self class allInstVarNames + indexOf: aSymbol asString + ifAbsent: [ ^ aBlock value ]) +! ! + +!PPCompositeParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +start + "Answer the production to start this parser with." + + self subclassResponsibility +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPCompositeParser class' category: #Tools! +PPCompositeParser class + instanceVariableNames: ''! + +!PPCompositeParser class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +ignoredNames + "Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser." + + ^ PPCompositeParser allInstVarNames +! ! + +!PPCompositeParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +new + "Answer a new parser starting at the default start symbol." + + ^ self newStartingAt: self startSymbol +! ! + +!PPCompositeParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +newStartingAt: aSymbol + ^self basicNew initializeStartingAt: aSymbol +! ! + +!PPCompositeParser class methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parse: anObject + ^self parse: anObject startingAt: self startSymbol +! ! + +!PPCompositeParser class methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parse: anObject onError: aBlock + ^ self parse: anObject startingAt: self startSymbol onError: aBlock +! ! + +!PPCompositeParser class methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parse: anObject startingAt: aSymbol + ^ (self newStartingAt: aSymbol) parse: anObject +! ! + +!PPCompositeParser class methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parse: anObject startingAt: aSymbol onError: aBlock + ^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock +! ! + +!PPCompositeParser class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +startSymbol + "Answer the method that represents the default start symbol." + + ^ #start +! ! + + diff --git a/modules/PetitParser/Tools/PPExpressionParser.Class.st b/modules/PetitParser/Tools/PPExpressionParser.Class.st new file mode 100644 index 00000000..6997ed37 --- /dev/null +++ b/modules/PetitParser/Tools/PPExpressionParser.Class.st @@ -0,0 +1,131 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPExpressionParser category: #Tools! +PPDelegateParser subclass: #PPExpressionParser + instanceVariableNames: 'operators' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools'! +!PPExpressionParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPExpressionParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +build: aParser left: aChoiceParser + ^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ] +! ! + +!PPExpressionParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +build: aParser postfix: aChoiceParser + ^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ] +! ! + +!PPExpressionParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +build: aParser prefix: aChoiceParser + ^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ] +! ! + +!PPExpressionParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +build: aParser right: aChoiceParser + ^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ] +! ! + +!PPExpressionParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +buildOn: aParser + ^self buildSelectors + inject: aParser + into: [:term :selector | self buildTerm: term selector: selector] +! ! + +!PPExpressionParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +buildSelectors + ^ #(build:prefix: build:postfix: build:right: build:left:) +! ! + +!PPExpressionParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +buildTerm: term selector: selector + | list | + list := operators at: selector ifAbsent: [#()]. + ^list isEmpty ifTrue: [term] ifFalse: [ + self perform: selector with: term with: (list size = 1 + ifTrue: [ + list first first ==> [:operator | + list isEmpty ifTrue: [self halt]. + {list first second. operator}]] + ifFalse: [ + list + inject: PPChoiceParser new + into: [:choice :each | choice + / (each first ==> [:operator | {each second. operator}])]])] +! ! + +!PPExpressionParser methodsFor: 'specifying' stamp: 'KenD 28/Jun/2026 13:27:39'! +group: aOneArgumentBlock + "Defines a priority group by evaluating aOneArgumentBlock." + + operators := Dictionary new. + parser := [ + aOneArgumentBlock value: self. + self buildOn: parser ] + ensure: [ operators := nil ] +! ! + +!PPExpressionParser methodsFor: 'specifying' stamp: 'KenD 28/Jun/2026 13:27:39'! +left: aParser do: aThreeArgumentBlock + "Define an operator aParser that is left-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term." + + self operator: #build:left: parser: aParser do: aThreeArgumentBlock +! ! + +!PPExpressionParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +operator: aSymbol parser: aParser do: aBlock + parser isNil + ifTrue: [^self + error: 'You did not specify a term when creating the receiver.']. + operators isNil + ifTrue: [^self + error: 'Use #group: to define precedence groups in descending order.']. + (operators at: aSymbol ifAbsentPut: [OrderedCollection new]) + addLast: {aParser asParser. aBlock} +! ! + +!PPExpressionParser methodsFor: 'specifying' stamp: 'KenD 28/Jun/2026 13:27:39'! +postfix: aParser do: aTwoArgumentBlock + "Define a postfix operator aParser. Evaluate aTwoArgumentBlock with the term and the operator." + + self operator: #build:postfix: parser: aParser do: aTwoArgumentBlock +! ! + +!PPExpressionParser methodsFor: 'specifying' stamp: 'KenD 28/Jun/2026 13:27:39'! +prefix: aParser do: aTwoArgumentBlock + "Define a prefix operator aParser. Evaluate aTwoArgumentBlock with the operator and the term." + + self operator: #build:prefix: parser: aParser do: aTwoArgumentBlock +! ! + +!PPExpressionParser methodsFor: 'specifying' stamp: 'KenD 28/Jun/2026 13:27:39'! +right: aParser do: aThreeArgumentBlock + "Define an operator aParser that is right-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term." + + self operator: #build:right: parser: aParser do: aThreeArgumentBlock +! ! + +!PPExpressionParser methodsFor: 'specifying' stamp: 'KenD 28/Jun/2026 13:27:39'! +term: aParser + "Defines the initial term aParser of the receiver." + + parser isNil + ifTrue: [ parser := aParser ] + ifFalse: [ self error: 'Unable to redefine the term.' ] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPExpressionParser class' category: #Tools! +PPExpressionParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Tools/PPUnresolvedParser.Class.st b/modules/PetitParser/Tools/PPUnresolvedParser.Class.st new file mode 100644 index 00000000..3f582a6c --- /dev/null +++ b/modules/PetitParser/Tools/PPUnresolvedParser.Class.st @@ -0,0 +1,32 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #PPUnresolvedParser category: #Tools! +PPParser subclass: #PPUnresolvedParser + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools'! +!PPUnresolvedParser commentStamp: '' prior: 0! + + Copyright (c) 2020 Aucerna. + Copyright (c) 2008-2019 The Pharo Project, and Contributors. + See (MIT) license in root directory. +! + +!PPUnresolvedParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isUnresolved + ^ true +! ! + +!PPUnresolvedParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseOn: aStream + self error: self printString , ' need to be resolved before execution.' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PPUnresolvedParser class' category: #Tools! +PPUnresolvedParser class + instanceVariableNames: ''! + + diff --git a/modules/PetitParser/Tools/ToolsModule.Class.st b/modules/PetitParser/Tools/ToolsModule.Class.st new file mode 100644 index 00000000..db42a751 --- /dev/null +++ b/modules/PetitParser/Tools/ToolsModule.Class.st @@ -0,0 +1,30 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #ToolsModule category: #PetitParser! +Module subclass: #ToolsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'PetitParser'! +!ToolsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #PetitParser.Parsers -> #(#PPDelegateParser #PPParser) + } +! ! + +!ToolsModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + self name: #'PetitParser.Tools' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ToolsModule class' category: #PetitParser! +ToolsModule class + instanceVariableNames: ''! + + +ToolsModule initialize! + diff --git a/modules/Random/Random.Class.st b/modules/Random/Random.Class.st new file mode 100644 index 00000000..a0e56f9a --- /dev/null +++ b/modules/Random/Random.Class.st @@ -0,0 +1,150 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #Random category: #Random! +Object subclass: #Random + instanceVariableNames: 'state seed' + classVariableNames: '' + poolDictionaries: '' + category: 'Random'! +!Random commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. + + Based on Random from Pharo (MIT license). + PCG implementation: (c) 2014 M.E. O'Neill / pcg-random.org (Apache License 2.0). + + Implements a PCG XSH-RR random number generator with 64-bit internal state. + The generator state is held in a 1-element Array (`state`) which is mutated + in place by `primitiveRandomNumber:`. The `seed` ivar tracks the current + state value (updated before each step in `privateNextValue`), so that + `seed` reflects the generator's evolving position rather than just + the initial seed. Sending `seed:` resets both the `seed` ivar and + the internal state (via `setStateFromSeed`), allowing save/restore + of the generator's position. +! + +!Random methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +maxValue + ^16r7FFFFFFF +! ! + +!Random methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +next + "Answer a random Float in the interval [0 to 1)." + ^self privateNextValue asFloat / (self maxValue + 1) +! ! + +!Random methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +next: anInteger + ^self next: anInteger into: (Array new: anInteger) +! ! + +!Random methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +next: anInteger into: anArray + 1 to: anInteger do: [:index | anArray at: index put: self next]. + ^anArray +! ! + +!Random methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +nextBetween: lowerBound and: higherBound + "Answer a random float number from the range [lowerBound, higherBound)" + ^lowerBound + (self next * (higherBound - lowerBound)) +! ! + +!Random methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +nextInteger: anInteger + "Answer a random integer in the interval [1, anInteger]." + anInteger strictlyPositive ifFalse: [ + self error: 'Range must be positive']. + ^(self privateNextValue / (self maxValue + 1) * anInteger) truncated + 1 +! ! + +!Random methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +nextIntegerBetween: lowerBound and: higherBound + "Answer a random integer number from the inclusive range [lowerBound, higherBound]" + ^lowerBound + (self nextInteger: higherBound - lowerBound + 1) - 1 +! ! + +!Random methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +state + ^state +! ! + +!Random methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + super initialize. + state := Array new: 1 +! ! + +!Random methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +seed: aNumber + seed := aNumber asInteger. + self setStateFromSeed +! ! + +!Random methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +setStateFromSeed + state at: 1 put: seed + 1442695040888963407. + self class primitiveRandomNumber: state +! ! + +!Random methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +useClockBasedSeed + "Set seed based on the host millisecond clock." + [ + seed := (Kernel host currentMilliseconds bitAnd: 16rFFFFFFFFFFFFFFFF) + bitXor: self hash. + seed = 0] whileTrue. + self setStateFromSeed +! ! + +!Random methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +privateNextValue + seed := state at: 1. + ^self class primitiveRandomNumber: state +! ! + +!Random methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +seed + ^seed +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'Random class' category: #Random! +Random class + instanceVariableNames: ''! + +!Random class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +new + ^super new useClockBasedSeed +! ! + +!Random class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +seed: anInteger + ^super new seed: anInteger +! ! + +!Random class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +primitiveRandomNumber: aState + "Answer a random integer in the interval [0, 16r7FFFFFFF]. + Implements the PCG XSH-RR algorithm on the 64-bit state." + | returnValue count xorshifted | + returnValue := aState first. + count := returnValue bitShiftRight: 59. + aState + at: 1 + put: (returnValue * 6364136223846793005 + + 1442695040888963407 + bitAnd: 16rFFFFFFFFFFFFFFFF). + returnValue := (returnValue bitShiftRight: 18) bitXor: returnValue. + xorshifted := (returnValue bitShiftRight: 27) bitAnd: 16rFFFFFFFF. + ^((xorshifted bitShiftRight: count) + bitOr: (xorshifted bitShift: (count negated bitAnd: 31))) + bitAnd: 16r7FFFFFFF +! ! + + +Random initialize! + diff --git a/modules/Random/RandomModule.Class.st b/modules/Random/RandomModule.Class.st new file mode 100644 index 00000000..1132209e --- /dev/null +++ b/modules/Random/RandomModule.Class.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #RandomModule category: #Random! +Module subclass: #RandomModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Random'! +!RandomModule commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!RandomModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(Float). + } +! ! + +!RandomModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +exports + ^#(Random) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RandomModule class' category: #Random! +RandomModule class + instanceVariableNames: ''! + + diff --git a/modules/Random/Tests/RandomTest.Class.st b/modules/Random/Tests/RandomTest.Class.st new file mode 100644 index 00000000..68272c67 --- /dev/null +++ b/modules/Random/Tests/RandomTest.Class.st @@ -0,0 +1,164 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #RandomTest category: #'Random.Tests'! +TestCase subclass: #RandomTest + instanceVariableNames: 'gen' + classVariableNames: '' + poolDictionaries: '' + category: 'Random.Tests'! +!RandomTest commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!RandomTest methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +setUp + super setUp. + gen := Random seed: 112629 +! ! + +!RandomTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:27:37'! +generateNewSequenceOfSize: aNumber withGenerator: aRandom + | results | + results := Array new: aNumber. + 1 to: aNumber do: [:i | + results at: i put: (aRandom nextIntegerBetween: 0 and: 16r7FFFFFFF)]. + ^results +! ! + +!RandomTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:37'! +testNext + 10000 timesRepeat: [ + | next | + next := gen next. + self assert: next >= 0. + self assert: next < 1] +! ! + +!RandomTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:37'! +testNextBetweenAnd + 10000 timesRepeat: [ + | next | + next := gen nextBetween: -10 and: 5. + self assert: next >= -10. + self assert: next < 5] +! ! + +!RandomTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:37'! +testNextInteger + | int | + int := gen nextInteger: 256. + self assert: int isInteger. + self assert: (int between: 1 and: 256) +! ! + +!RandomTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:37'! +testNextIntegerBetweenAnd + 10000 timesRepeat: [ + | next | + next := gen nextIntegerBetween: -3 and: 5. + self assert: next isInteger. + self assert: (next between: -3 and: 5)] +! ! + +!RandomTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:37'! +testNextInto + | array | + array := Array new: 8. + array := gen next: 8 into: array. + array do: [:each | + self assert: each isFloat. + self assert: each >= 0. + self assert: each < 1] +! ! + +!RandomTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:37'! +testPrimitiveRandomGeneration1 + self + assert: + (self generateNewSequenceOfSize: 100 withGenerator: (gen seed: 42)) + equals: + #( 1123384278 1795671209 1924641435 1143034755 1974427309 + 1757328946 1271345452 1441777623 2062288904 2131966645 + 898244057 1731076225 106581468 2027215766 1693907025 251273835 + 872213210 736288324 449296931 1097054660 1174969416 1493913367 + 727525072 1895983019 2045651843 601924129 790240170 274078875 + 85460756 661429448 1551229168 1346782475 331806902 2001698278 + 1653883637 969082088 58484890 877451631 106813142 879896758 + 1465586082 23970619 222390255 1872327836 132911854 169678554 + 685616442 1905681248 1101299353 543443413 10498198 1567420440 + 8429346 246076037 463063522 1131711124 352105423 1100034716 + 1647334895 972870151 1415116872 419609241 810313841 1259894043 + 1073135744 969363312 1568528795 664453680 1680803242 460188684 + 1401049631 1589666895 324952468 2133811574 2125455444 1469931429 + 387789563 881643062 1751561152 16000064 56618491 1697760127 + 1756201022 566280575 1702381265 413278598 514120285 2138146072 + 1826857778 878121720 1338240606 1068671382 403284681 815313315 + 391109809 395500445 774308967 509549754 1714383213 1069569682 ) +! ! + +!RandomTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:37'! +testPrimitiveRandomGeneration2 + self + assert: + (self generateNewSequenceOfSize: 100 withGenerator: (gen seed: 4112000)) + equals: + #( 911034467 623064739 2069461119 1776170644 2133203577 1730457956 + 324747982 363675164 1904345172 1621255112 1297556496 23505356 + 1355834468 160610595 1617487803 1039549212 1846883319 2010354200 + 476369801 171757954 989848022 1603079100 1314026991 1454207784 + 2078473025 227444708 504950213 1345591439 600653439 449189537 + 324817986 914192558 1239256601 395373279 501565559 256583195 + 715973605 1269777629 314601761 1690741703 155672304 2037828346 + 1973102905 1150196189 546648478 1888933509 521133230 1757563876 + 1339955536 431524952 704934916 1711974879 70559250 1982829667 + 1110020946 1707037755 1973351774 1942247750 1217323071 + 1125713023 1148575093 364025800 2112712187 1191251157 1293701689 + 1325582175 848888591 1835433750 198980106 1331838368 602369642 + 1749496722 1726468786 1537953647 395924263 190370818 949685575 + 1337449940 918067889 2043992072 374792107 865520841 798576892 + 554778780 755314185 616251642 1095303820 1762283268 207097256 + 1698265582 657252139 1166599601 1256604542 1336871508 98506035 + 1267254030 2056734050 1359495350 1088203006 1024528242 ) +! ! + +!RandomTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:37'! +testPrimitiveRandomGeneration3 + self + assert: + (self generateNewSequenceOfSize: 100 withGenerator: (gen seed: 123456)) + equals: + #( 566038743 1171143710 196292920 1669880209 1144641032 1992765256 + 659093549 14218717 2061950801 1678079829 1578110325 1879404830 + 1933870707 434085891 341950436 625432323 1134678563 859685437 + 1236225730 315560151 852048096 1922244605 925650437 504664098 + 1260282598 465193379 245828783 279261993 1902667837 5944093 + 2136271957 1094758864 329209476 105592850 1897929857 1913195112 + 821050896 643503696 776471402 1415619124 700430832 355145952 + 1353942448 1074383166 2140513849 159165778 932788109 673910915 + 1417469399 258047532 939982909 2086845843 1112252639 1003572104 + 1719096493 2029507176 685431625 1070730662 833670055 2041486110 + 968545889 1011430722 1287709220 885237954 1257267839 2003737035 + 935102566 1481687452 1302662897 1254412380 1759700629 1564192767 + 661511340 227189186 302694750 1035479791 876735686 1001817412 + 1647194895 440089346 331642580 1825295173 617063505 10834473 + 863891414 1393364432 1164413488 1487711579 717709665 981313536 + 1334721008 1303947308 627686644 2053289872 878240920 891827854 + 498333902 399158151 832415416 1705443437 ) +! ! + +!RandomTest methodsFor: 'tests' stamp: 'KenD 28/Jun/2026 13:27:37'! +testWithFloatAsSeed + | r | + r := Random seed: 10.5. + self assert: r seed equals: 10.5 asInteger +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'RandomTest class' category: #'Random.Tests'! +RandomTest class + instanceVariableNames: ''! + + diff --git a/modules/Random/Tests/TestsModule.Class.st b/modules/Random/Tests/TestsModule.Class.st new file mode 100644 index 00000000..157b5eca --- /dev/null +++ b/modules/Random/Tests/TestsModule.Class.st @@ -0,0 +1,46 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestsModule category: #'Random.Tests'! +Module subclass: #TestsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Random.Tests'! +!TestsModule commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!TestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(Float). + #Random -> #(Random). + #SUnit -> #(TestCase TestResult) + } +! ! + +!TestsModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:37'! +main: anArray + | suite result | + Kernel log: 'Running Random tests... +'. + suite := RandomTest buildTestSuite. + Kernel log: 'suite built with ', suite tests size printString, ' tests +'. + result := suite run. + Kernel log: 'Done. +'. + Kernel log: result printString. + Kernel log: ' +' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestsModule class' category: #'Random.Tests'! +TestsModule class + instanceVariableNames: ''! + + diff --git a/modules/STON/Association.Extension.st b/modules/STON/Association.Extension.st new file mode 100644 index 00000000..802f23a7 --- /dev/null +++ b/modules/STON/Association.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Association methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeAssociation: self +! ! + + diff --git a/modules/STON/Boolean.Extension.st b/modules/STON/Boolean.Extension.st new file mode 100644 index 00000000..803cd62c --- /dev/null +++ b/modules/STON/Boolean.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Boolean methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeBoolean: self +! ! + + diff --git a/modules/STON/ByteArray class.Extension.st b/modules/STON/ByteArray class.Extension.st new file mode 100644 index 00000000..39fa8568 --- /dev/null +++ b/modules/STON/ByteArray class.Extension.st @@ -0,0 +1,35 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!ByteArray methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +readHexFrom: aStream + | map | + map := '0123456789abcdef'. + 1 to: self size do: [:i | | hi lo | + hi := map + indexOf: aStream next asLowercase + ifAbsent: [^self error: 'Hex digit expected']. + hi := hi - 1 bitShift: 4. + lo := map + indexOf: aStream next asLowercase + ifAbsent: [^self error: 'Hex digit expected']. + self at: i put: hi + lo - 1] +! ! + +!ByteArray methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeObject: self listSingleton: self hexString +! ! + +!ByteArray class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + ^self readHexFrom: stonReader parseListSingleton +! ! + +!ByteArray class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +readHexFrom: aString + self ASSERT: aString size even. + ^(self new: aString size // 2) readHexFrom: aString readStream +! ! + + diff --git a/modules/STON/Character class.Extension.st b/modules/STON/Character class.Extension.st new file mode 100644 index 00000000..3dedfb80 --- /dev/null +++ b/modules/STON/Character class.Extension.st @@ -0,0 +1,14 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Character methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeObject: self listSingleton: self asString +! ! + +!Character class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + ^ stonReader parseListSingleton first +! ! + + diff --git a/modules/STON/Class class.Extension.st b/modules/STON/Class class.Extension.st new file mode 100644 index 00000000..0acbd7df --- /dev/null +++ b/modules/STON/Class class.Extension.st @@ -0,0 +1,14 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeObject: self listSingleton: self symbol +! ! + +!Class class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + ^Smalltalk at: stonReader parseListSingleton +! ! + + diff --git a/modules/STON/Closure.Extension.st b/modules/STON/Closure.Extension.st new file mode 100644 index 00000000..0bba9e06 --- /dev/null +++ b/modules/STON/Closure.Extension.st @@ -0,0 +1,11 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Closure methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +cull: a cull: b + ^self argumentCount < 2 + ifTrue: [self cull: a] + ifFalse: [self value: a value: b] +! ! + + diff --git a/modules/STON/Collection class.Extension.st b/modules/STON/Collection class.Extension.st new file mode 100644 index 00000000..38c8a0c0 --- /dev/null +++ b/modules/STON/Collection class.Extension.st @@ -0,0 +1,20 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Collection methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeObject: self do: [aSTONWriter encodeList: self] +! ! + +!Collection class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + | collection | + collection := self new. + stonReader parseListDo: [:element | + collection add: element. + element isStonReference + ifTrue: [stonReader addElement: element of: collection]]. + ^collection +! ! + + diff --git a/modules/STON/Date class.Extension.st b/modules/STON/Date class.Extension.st new file mode 100644 index 00000000..94fd28f1 --- /dev/null +++ b/modules/STON/Date class.Extension.st @@ -0,0 +1,14 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Date methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: stonWriter + stonWriter writeObject: self listSingleton: self yyyymmdd +! ! + +!Date class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + ^self yyyymmdd: stonReader parseListSingleton +! ! + + diff --git a/modules/STON/Dictionary class.Extension.st b/modules/STON/Dictionary class.Extension.st new file mode 100644 index 00000000..1223a033 --- /dev/null +++ b/modules/STON/Dictionary class.Extension.st @@ -0,0 +1,22 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Dictionary methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + self class == STON mapClass + ifTrue: [aSTONWriter writeMap: self] + ifFalse: [aSTONWriter writeObject: self do: [aSTONWriter encodeMap: self]] +! ! + +!Dictionary class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + | dictionary | + dictionary := self new. + stonReader parseMapDo: [:key :value | + dictionary at: key put: value. + (key isStonReference or: [value isStonReference]) + ifTrue: [stonReader addReferenceKey: key value: value of: dictionary]]. + ^dictionary +! ! + + diff --git a/modules/STON/HashedCollection.Extension.st b/modules/STON/HashedCollection.Extension.st new file mode 100644 index 00000000..4baa848c --- /dev/null +++ b/modules/STON/HashedCollection.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!HashedCollection methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonPostReferenceResolution + self rehash +! ! + + diff --git a/modules/STON/Integer.Extension.st b/modules/STON/Integer.Extension.st new file mode 100644 index 00000000..f75bfdcc --- /dev/null +++ b/modules/STON/Integer.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Integer methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeInteger: self +! ! + + diff --git a/modules/STON/Interval class.Extension.st b/modules/STON/Interval class.Extension.st new file mode 100644 index 00000000..48b8810a --- /dev/null +++ b/modules/STON/Interval class.Extension.st @@ -0,0 +1,19 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Interval methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: aSTONReader + aSTONReader parseNamedInstVarsFor: self +! ! + +!Interval methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeObject: self +! ! + +!Interval class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + ^self new fromSton: stonReader; yourself +! ! + + diff --git a/modules/STON/Metaclass class.Extension.st b/modules/STON/Metaclass class.Extension.st new file mode 100644 index 00000000..c4133c7f --- /dev/null +++ b/modules/STON/Metaclass class.Extension.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Metaclass class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + | class | + class := Smalltalk at: stonReader parseListSingleton. + ^class class +! ! + +!Metaclass methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonName + ^#Class +! ! + +!Metaclass methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeObject: self listSingleton: self instanceClass symbol +! ! + + diff --git a/modules/STON/Number.Extension.st b/modules/STON/Number.Extension.st new file mode 100644 index 00000000..55460bb8 --- /dev/null +++ b/modules/STON/Number.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Number methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeFloat: self asFloat +! ! + + diff --git a/modules/STON/Object class.Extension.st b/modules/STON/Object class.Extension.st new file mode 100644 index 00000000..e58d6dd4 --- /dev/null +++ b/modules/STON/Object class.Extension.st @@ -0,0 +1,51 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Object methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: aSTONReader + self class isVariable + ifTrue: [ + aSTONReader + error: 'custom #fromSton: implementation needed for variable/indexable class'] + ifFalse: [aSTONReader parseNamedInstVarsFor: self] +! ! + +!Object methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +isStonReference + ^false +! ! + +!Object methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + self class isVariable + ifTrue: [ + aSTONWriter + error: 'custom #stonOn: implementation needed for variable/indexable class'] + ifFalse: [aSTONWriter writeObject: self] +! ! + +!Object methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonPostReferenceResolution + +! ! + +!Object class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + ^self new fromSton: stonReader; yourself +! ! + +!Object class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonAllInstVarNames + "Override to encode my instances using a custom set of instance variables or to define their order." + + ^ self allInstVarNames +! ! + +!Object class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonName + "Override to encode my instances using a different class name." + + ^ self name +! ! + + diff --git a/modules/STON/OrderedDictionary.Extension.st b/modules/STON/OrderedDictionary.Extension.st new file mode 100644 index 00000000..bc1ea0e7 --- /dev/null +++ b/modules/STON/OrderedDictionary.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!OrderedDictionary methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeObject: self do: [aSTONWriter encodeMap: self] +! ! + + diff --git a/modules/STON/Point.Extension.st b/modules/STON/Point.Extension.st new file mode 100644 index 00000000..5649c861 --- /dev/null +++ b/modules/STON/Point.Extension.st @@ -0,0 +1,18 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Point methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: aSTONReader + aSTONReader parseListDo: [:v :i | + i = 1 ifTrue: [x := v]. + i = 2 ifTrue: [y := v]] +! ! + +!Point methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: stonWriter + stonWriter + writeObject: self + streamShortList: [:writer | writer add: x; add: y] +! ! + + diff --git a/modules/STON/STON.Class.st b/modules/STON/STON.Class.st new file mode 100644 index 00000000..2c7359c2 --- /dev/null +++ b/modules/STON/STON.Class.st @@ -0,0 +1,109 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STON category: #STON! +Object subclass: #STON + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'STON'! +!STON commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STON class' category: #STON! +STON class + instanceVariableNames: ''! + +!STON class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +associationClass + ^ Association +! ! + +!STON class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +classNameKey + ^ #className +! ! + +!STON class methodsFor: 'convencience' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromStream: readStream + ^ (self reader on: readStream) next +! ! + +!STON class methodsFor: 'convencience' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromString: string + ^ self fromStream: string readStream +! ! + +!STON class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +jsonWriter + ^STONWriter new jsonMode: true +! ! + +!STON class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +listClass + ^Array +! ! + +!STON class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +mapClass + ^Dictionary +! ! + +!STON class methodsFor: 'convencience' stamp: 'KenD 28/Jun/2026 13:27:39'! +put: object asJsonOnStream: stream + self jsonWriter on: stream; nextPut: object +! ! + +!STON class methodsFor: 'convencience' stamp: 'KenD 28/Jun/2026 13:27:39'! +put: object asJsonOnStreamPretty: stream + self jsonWriter on: stream; nextPut: object +! ! + +!STON class methodsFor: 'convencience' stamp: 'KenD 28/Jun/2026 13:27:39'! +put: object onStream: stream + (self writer on: stream) nextPut: object +! ! + +!STON class methodsFor: 'convencience' stamp: 'KenD 28/Jun/2026 13:27:39'! +put: object onStreamPretty: stream + self writer on: stream; nextPut: object +! ! + +!STON class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +reader + ^ STONReader new +! ! + +!STON class methodsFor: 'convencience' stamp: 'KenD 28/Jun/2026 13:27:39'! +toJsonString: object + ^String streamContents: [:stream | self put: object asJsonOnStream: stream] +! ! + +!STON class methodsFor: 'convencience' stamp: 'KenD 28/Jun/2026 13:27:39'! +toJsonStringPretty: object + ^ String streamContents: [ :stream | + self put: object asJsonOnStreamPretty: stream ] +! ! + +!STON class methodsFor: 'convencience' stamp: 'KenD 28/Jun/2026 13:27:39'! +toString: object + ^ String streamContents: [ :stream | + self put: object onStream: stream ] +! ! + +!STON class methodsFor: 'convencience' stamp: 'KenD 28/Jun/2026 13:27:39'! +toStringPretty: object + ^ String streamContents: [ :stream | + self put: object onStreamPretty: stream ] +! ! + +!STON class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writer + ^ STONWriter new +! ! + + diff --git a/modules/STON/STONJSON.Class.st b/modules/STON/STONJSON.Class.st new file mode 100644 index 00000000..19adfec1 --- /dev/null +++ b/modules/STON/STONJSON.Class.st @@ -0,0 +1,51 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STONJSON category: #STON! +Object subclass: #STONJSON + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'STON'! +!STONJSON commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STONJSON class' category: #STON! +STONJSON class + instanceVariableNames: ''! + +!STONJSON class methodsFor: 'convenience' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromStream: stream + ^ STON fromStream: stream +! ! + +!STONJSON class methodsFor: 'convenience' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromString: string + ^ STON fromString: string +! ! + +!STONJSON class methodsFor: 'convenience' stamp: 'KenD 28/Jun/2026 13:27:39'! +put: object onStream: stream + STON put: object asJsonOnStream: stream +! ! + +!STONJSON class methodsFor: 'convenience' stamp: 'KenD 28/Jun/2026 13:27:39'! +put: object onStreamPretty: stream + STON put: object asJsonOnStreamPretty: stream +! ! + +!STONJSON class methodsFor: 'convenience' stamp: 'KenD 28/Jun/2026 13:27:39'! +toString: object + ^ STON toJsonString: object +! ! + +!STONJSON class methodsFor: 'convenience' stamp: 'KenD 28/Jun/2026 13:27:39'! +toStringPretty: object + ^ STON toJsonStringPretty: object +! ! + + diff --git a/modules/STON/STONMapWriter.Class.st b/modules/STON/STONMapWriter.Class.st new file mode 100644 index 00000000..f2d5681b --- /dev/null +++ b/modules/STON/STONMapWriter.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STONMapWriter category: #STON! +STONStreamWriter subclass: #STONMapWriter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'STON'! +!STONMapWriter commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!STONMapWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +comma + writer comma; cr +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STONMapWriter class' category: #STON! +STONMapWriter class + instanceVariableNames: ''! + + diff --git a/modules/STON/STONModule.Class.st b/modules/STON/STONModule.Class.st new file mode 100644 index 00000000..b08d0482 --- /dev/null +++ b/modules/STON/STONModule.Class.st @@ -0,0 +1,36 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STONModule category: #STON! +Module subclass: #STONModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'STON'! +!STONModule commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!STONModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #Kernel -> {#Error. #Association. #Boolean. #ByteArray. #Closure. #Collection. #Date. #Dictionary. + #HashedCollection. #Integer. #Interval. #Module. #Number. #OrderedDictionary. #Point. #SequenceableCollection. + #String. #Symbol. #Time. #Timestamp. #UndefinedObject. #IdentityDictionary. #MessageNotUnderstood}. + } +! ! + +!STONModule methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:39'! +justLoaded + super justLoaded. + STONWriter initialize +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STONModule class' category: #STON! +STONModule class + instanceVariableNames: ''! + + diff --git a/modules/STON/STONReader.Class.st b/modules/STON/STONReader.Class.st new file mode 100644 index 00000000..7e64c9ea --- /dev/null +++ b/modules/STON/STONReader.Class.st @@ -0,0 +1,522 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STONReader category: #STON! +Object subclass: #STONReader + instanceVariableNames: 'stream objects classes unresolved stringStream references' + classVariableNames: '' + poolDictionaries: '' + category: 'STON'! +!STONReader commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!STONReader methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addElement: v of: collection + self addElement: v of: collection at: nil +! ! + +!STONReader methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addElement: element of: collection at: index + | data | + references isNil ifTrue: [references := OrderedCollection new]. + data := index isNil + ifTrue: [{#elem. element. collection}] + ifFalse: [{#elem. element. collection. index}]. + references add: data +! ! + +!STONReader methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addReference: aSTONReference of: anObject at: anInteger + references isNil ifTrue: [references := OrderedCollection new]. + references add: {#ref. aSTONReference index. anObject. anInteger} +! ! + +!STONReader methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addReferenceKey: k value: v of: dictionary + references isNil ifTrue: [references := OrderedCollection new]. + references add: {#assoc. k. dictionary. v} +! ! + +!STONReader methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +atEnd + ^stream atEnd +! ! + +!STONReader methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:27:39'! +close + stream isNil ifTrue: [^self]. + stream close. + stream := nil +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +consumeWhitespace + stream skipSeparators +! ! + +!STONReader methodsFor: 'error handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +error: aString + | position | + position := [stream position] on: MessageNotUnderstood do: []. + ^STONReaderError signal: aString streamPosition: position +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +expectChar: aCharacter + (self matchChar: aCharacter) + ifFalse: [self error: aCharacter asString , ' expected'] +! ! + +!STONReader methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + objects := IdentityDictionary new. + classes := IdentityDictionary new. + unresolved := 0 +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +isClassChar: aCharacter + ^'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_' + includes: aCharacter +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSimpleSymbolChar: aCharacter + ^aCharacter isLetter or: ['0123456789-_./' includes: aCharacter] +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +lookupClass: aString + (Smalltalk classNamed: aString) ifNotNil: [:class | ^class]. + ^classes at: aString ifAbsentPut: [ + Object allSubclasses + detect: [:class | class isMetaclass not and: [class stonName = aString]] + ifNone: [Error signal: aString , ' not found']] +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +match: aString do: aBlock + (aString conform: [:ch | stream peekFor: ch]) ifTrue: [ + self consumeWhitespace. + aBlock value] +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +matchChar: aCharacter + ^(stream peekFor: aCharacter) ifTrue: [self consumeWhitespace]; yourself +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +newReference + | index reference | + index := objects size + 1. + reference := STONReference index: index. + ^objects at: index put: reference +! ! + +!STONReader methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +next + | object | + self consumeWhitespace. + object := self parseValue. + unresolved > 0 ifTrue: [self processUnresolved]. + unresolved = 0 ifFalse: [self error: 'Inconsistent reference resolution']. + objects do: [:o | o stonPostReferenceResolution]. + ^object +! ! + +!STONReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aStream + stream := aStream +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseCharacter + | char | + char := stream next. + ^char = $\ ifTrue: [self parseEscapedCharacter] ifFalse: [char] +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseCharacterHex + | value code | + value := self parseCharacterHex4Value. + (value < 16rD800 or: [value > 16rDBFF]) + ifTrue: [code := value] + ifFalse: [| lead trail | + lead := value. + trail := self parseTrailingSurrogateHexEscape. + code := lead - 16rD800 * 16r400 + (trail - 16rDC00). + code := 16r10000 + code]. + ^Character codePoint: code +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseCharacterHex4Value + | value | + value := self parseCharacterHexDigit. + 3 timesRepeat: [value := (value bitShift: 4) + self parseCharacterHexDigit]. + ^value +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseCharacterHexDigit + | digit | + stream atEnd ifFalse: [ + digit := stream next asInteger. + (digit between: 48 and: 57) ifTrue: [^digit - 48]. + (digit between: 65 and: 70) ifTrue: [^digit - 55]. + (digit between: 97 and: 102) ifTrue: [^digit - 87]]. + self error: 'hex-digit expected' +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseClass + | class | + class := self stringStreamContents: [:strm | + [stream atEnd not and: [self isClassChar: stream peek]] + whileTrue: [strm nextPut: stream next]]. + self consumeWhitespace. + ^self lookupClass: class asSymbol +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseConstantDo: aBlock + | keys values | + keys := #('true' 'false' 'nil' 'null'). + values := #(true false nil nil). + 1 to: keys size do: [:i | | key | + key := keys at: i. + (stream peek = key first and: [(stream peek: key size) = key]) ifTrue: [ + stream skip: key size. + self consumeWhitespace. + ^aBlock value: (values at: i)]] +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseEscapedCharacter + | char | + char := stream next. + (#($' $" $/ $\) includes: char) ifTrue: [^char]. + char = $b ifTrue: [^Character backspace]. + char = $f ifTrue: [^Character newPage]. + char = $n ifTrue: [^Character lf]. + char = $r ifTrue: [^Character cr]. + char = $t ifTrue: [^Character tab]. + char = $u ifTrue: [^self parseCharacterHex]. + self error: 'invalid escape character \' , char asString. + ^char +! ! + +!STONReader methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseList + | reference refs i array | + reference := self newReference. + refs := OrderedCollection new. + i := 1. + array := STON listClass streamContents: [:strm | + self parseListDo: [:element | + strm nextPut: element. + element isStonReference ifTrue: [refs add: {element. i}]. + i := i + 1]]. + refs do: [:ref | self addElement: ref first of: array at: ref second]. + self setReference: reference to: array. + ^array +! ! + +!STONReader methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseListDo: aBlock + | index | + self expectChar: $[. + (self matchChar: $]) ifTrue: [^self]. + index := 1. + [stream atEnd] whileFalse: [ + aBlock cull: self parseValue cull: index. + (self matchChar: $]) ifTrue: [^self]. + index := index + 1. + self expectChar: $,]. + self error: 'end of list expected' +! ! + +!STONReader methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseListSingleton + | value | + value := nil. + self parseListDo: [:element :i | i = 1 ifTrue: [value := element]]. + ^value +! ! + +!STONReader methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseMap + | map | + map := STON mapClass new. + self + storeReference: map; + parseMapDo: [:key :value | + map at: key put: value. + (key isStonReference or: [value isStonReference]) + ifTrue: [self addReferenceKey: key value: value of: map]]. + ^map +! ! + +!STONReader methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseMapDo: aBlock + self expectChar: ${. + (self matchChar: $}) ifTrue: [^self]. + [stream atEnd] whileFalse: [| name value | + name := self parseSimpleValue. + self expectChar: $:. + value := self parseValue. + aBlock value: name value: value. + (self matchChar: $}) ifTrue: [^self]. + self expectChar: $,]. + self error: 'end of map expected' +! ! + +!STONReader methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseNamedInstVarsFor: anObject + | i | + i := 1. + self parseMapDo: [:ivar :value | + anObject instVarNamed: ivar put: value. + value isStonReference + ifTrue: [self addReference: value of: anObject at: i]. + i := i + 1] +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseNumber + | negated number | + negated := stream peekFor: $-. + number := self parseNumberInteger. + (stream peekFor: $.) ifTrue: [number := number + self parseNumberFraction]. + ((stream peekFor: $e) or: [stream peekFor: $E]) + ifTrue: [number := number * self parseNumberExponent]. + negated ifTrue: [number := number negated]. + self consumeWhitespace. + ^number +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseNumberExponent + | number negated | + number := 0. + negated := stream peekFor: $-. + negated ifFalse: [stream peekFor: $+]. + [stream atEnd not and: [stream peek isDigit]] + whileTrue: [number := 10 * number + stream next digitValue]. + negated ifTrue: [number := number negated]. + ^10 raisedTo: number +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseNumberFraction + | number power | + number := 0. + power := 1.0. + [stream atEnd not and: [stream peek isDigit]] whileTrue: [ + number := 10 * number + stream next digitValue. + power := power * 10.0]. + ^number / power +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseNumberInteger + | number | + number := 0. + [stream atEnd not and: [stream peek isDigit]] + whileTrue: [number := 10 * number + stream next digitValue]. + ^number +! ! + +!STONReader methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseObject + | object | + [| reference class | + reference := self newReference. + class := self parseClass. + object := class fromSton: self. + self setReference: reference to: object] + on: Error + do: [self error: 'Cannot resolve class named ' , object printString]. + ^object +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseReference + | index | + self expectChar: $@. + index := self parseNumberInteger. + self consumeWhitespace. + unresolved := unresolved + 1. + ^STONReference index: index +! ! + +!STONReader methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseSimpleValue + | char | + stream atEnd ifFalse: [ + char := stream peek. + self parseConstantDo: [:v | ^v]. + char isLetter ifTrue: [^self parseObject]. + char = ${ ifTrue: [^self parseMap]. + char = $[ ifTrue: [^self parseList]. + (char = $' or: [char = $"]) ifTrue: [^self parseString]. + char = $# ifTrue: [^self parseSymbol]. + char = $@ ifTrue: [^self parseReference]. + (char = $- or: [char isDigit]) ifTrue: [^self parseNumber]]. + self error: 'invalid input' +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseString + ^self parseStringInternal +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseStringInternal + | result delimiter | + delimiter := stream next. + (delimiter = $' or: [delimiter = $"]) + ifFalse: [self error: ''' or " expected']. + result := self stringStreamContents: [:strm | + [stream atEnd or: [stream peek = delimiter]] + whileFalse: [strm nextPut: self parseCharacter]]. + self expectChar: delimiter. + ^result +! ! + +!STONReader methodsFor: 'parsing-internal' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseSymbol + | string | + self expectChar: $#. + stream peek = $' ifTrue: [^self parseStringInternal asSymbol]. + string := self stringStreamContents: [:strm | + [stream atEnd not and: [self isSimpleSymbolChar: stream peek]] + whileTrue: [strm nextPut: stream next]]. + string isEmpty ifFalse: [ + self consumeWhitespace. + ^string asSymbol]. + self error: 'unexpected input' +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseTrailingSurrogateHexEscape + (stream next = $\ and: [stream next = $u]) + ifTrue: [^self parseCharacterHex4Value] + ifFalse: [self error: 'trailing surrogate hex escape expected'] +! ! + +!STONReader methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:39'! +parseValue + | value | + value := self parseSimpleValue. + ^(self matchChar: $:) + ifTrue: [STON associationClass key: value value: self parseValue] + ifFalse: [value] +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +process: data + | type | + type := data first. + type == #ref ifTrue: [^self processReference: data]. + type == #assoc ifTrue: [^self processAssociation: data]. + type == #elem ifTrue: [^self processElement: data]. + self error: 'unknown type' +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +processAssociation: data + | k v assoc | + k := data second isStonReference + ifTrue: [objects at: data second index] + ifFalse: [data second]. + v := data last isStonReference + ifTrue: [objects at: data last index] + ifFalse: [data last]. + assoc := data third associationAt: data second. + assoc key == k ifFalse: [data third removeKey: data second]. + data third at: k put: v +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +processElement: data + | o | + o := objects at: data second index. + data size = 4 + ifTrue: [data third at: data fourth put: o] + ifFalse: [data third remove: data second; add: o] +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +processReference: data + | o | + o := objects at: data second. + data third instVarAt: data fourth put: o +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +processUnresolved + [references size > 0] whileTrue: [ + self process: references removeFirst. + unresolved := unresolved - 1] +! ! + +!STONReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +reset + unresolved := 0. + objects removeAll. + references removeAll +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolveReference: reference + unresolved := unresolved - 1. + ^self resolveReferenceIndex: reference index +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolveReferenceIndex: anInteger + ^objects at: anInteger +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +setReference: aSTONReference to: anObject + objects at: aSTONReference index put: anObject +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +storeReference: anObject + | index | + index := objects size + 1. + objects at: index put: anObject. + ^index +! ! + +!STONReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +stringStreamContents: aBlock + stringStream isNil + ifTrue: [stringStream := '' writeStream] + ifFalse: [stringStream reset]. + aBlock value: stringStream. + ^stringStream contents +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STONReader class' category: #STON! +STONReader class + instanceVariableNames: ''! + +!STONReader class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aStream + ^self new on: aStream +! ! + + +STONReader initialize! + diff --git a/modules/STON/STONReaderError.Class.st b/modules/STON/STONReaderError.Class.st new file mode 100644 index 00000000..5ce14e0a --- /dev/null +++ b/modules/STON/STONReaderError.Class.st @@ -0,0 +1,55 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STONReaderError category: #STON! +Error subclass: #STONReaderError + instanceVariableNames: 'position' + classVariableNames: '' + poolDictionaries: '' + category: 'STON'! +!STONReaderError commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!STONReaderError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +description + position ifNil: [^super description]. + ^String streamContents: [:strm | + strm + nextPutAll: 'At character '; + nextPutAll: position asString; + space; + nextPutAll: super description] +! ! + +!STONReaderError methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +signal: aString + self description: aString; signal +! ! + +!STONReaderError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +streamPosition + ^ position +! ! + +!STONReaderError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +streamPosition: aNumber + position := aNumber +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STONReaderError class' category: #STON! +STONReaderError class + instanceVariableNames: ''! + +!STONReaderError class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +signal: aString streamPosition: streamPosition + ^ self new + streamPosition: streamPosition; + signal: aString; + yourself +! ! + + diff --git a/modules/STON/STONReference.Class.st b/modules/STON/STONReference.Class.st new file mode 100644 index 00000000..09b77178 --- /dev/null +++ b/modules/STON/STONReference.Class.st @@ -0,0 +1,57 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STONReference category: #STON! +Object subclass: #STONReference + instanceVariableNames: 'index' + classVariableNames: '' + poolDictionaries: '' + category: 'STON'! +!STONReference commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!STONReference methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! += anObject + ^self class == anObject class and: [self index = anObject index] +! ! + +!STONReference methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hash + ^index hash +! ! + +!STONReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index + ^index +! ! + +!STONReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +index: integer + index := integer +! ! + +!STONReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isStonReference + ^true +! ! + +!STONReference methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: stream + super printOn: stream. + stream nextPut: $(; print: index; nextPut: $) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STONReference class' category: #STON! +STONReference class + instanceVariableNames: ''! + +!STONReference class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +index: integer + ^self new index: integer +! ! + + diff --git a/modules/STON/STONStreamWriter.Class.st b/modules/STON/STONStreamWriter.Class.st new file mode 100644 index 00000000..053c6b18 --- /dev/null +++ b/modules/STON/STONStreamWriter.Class.st @@ -0,0 +1,56 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STONStreamWriter category: #STON! +Object subclass: #STONStreamWriter + instanceVariableNames: 'writer first' + classVariableNames: '' + poolDictionaries: '' + category: 'STON'! +!STONStreamWriter commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!STONStreamWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +add: anObject + first ifTrue: [first := false] ifFalse: [self comma]. + writer nextPut: anObject +! ! + +!STONStreamWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: key put: value + first ifTrue: [first := false] ifFalse: [self comma]. + writer encodeKey: key value: value +! ! + +!STONStreamWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +comma + writer comma +! ! + +!STONStreamWriter methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + first := true +! ! + +!STONStreamWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aSTONWriter + writer := aSTONWriter +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STONStreamWriter class' category: #STON! +STONStreamWriter class + instanceVariableNames: ''! + +!STONStreamWriter class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aSTONWriter + ^self new on: aSTONWriter +! ! + + +STONStreamWriter initialize! + diff --git a/modules/STON/STONWriter.Class.st b/modules/STON/STONWriter.Class.st new file mode 100644 index 00000000..d3a9023f --- /dev/null +++ b/modules/STON/STONWriter.Class.st @@ -0,0 +1,367 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STONWriter category: #STON! +Object subclass: #STONWriter + instanceVariableNames: 'stream stonCharacters json indent objects' + classVariableNames: 'STONCharacters STONSimpleSymbolCharacters' + poolDictionaries: '' + category: 'STON'! +!STONWriter commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!STONWriter methodsFor: 'open/close' stamp: 'KenD 28/Jun/2026 13:27:39'! +close + stream isNil ifTrue: [^self]. + stream close. + stream := nil +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +comma + stream nextPutAll: ', ' +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +cr + stream crtab: indent +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +encodeCharacter: char + | code encoding | + code := char codePoint. + (code < 127 and: [ + encoding := self stonCharacters at: code + 1. + encoding notNil]) + ifTrue: [ + (encoding == #pass or: [json and: [char = $']]) + ifTrue: [stream nextPut: char] + ifFalse: [stream nextPutAll: encoding]] + ifFalse: [self escapeUnicode: code] +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +encodeKey: key value: value + self nextPut: key. + stream nextPutAll: ' : '. + self nextPut: value +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +encodeList: aCollection + stream nextPut: $[. + aCollection notEmpty ifTrue: [ + self + indentedDo: [ + self cr. + aCollection + do: [:element | self nextPut: element] + separatedBy: [self comma; cr]]; + cr]. + stream nextPut: $] +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +encodeMap: pairs + | first single | + stream nextPut: ${. + pairs notEmpty ifTrue: [ + first := true. + single := pairs size = 1. + self indentedDo: [ + single ifFalse: [self cr]. + pairs keysAndValuesDo: [:key :value | + first ifTrue: [first := false] ifFalse: [ + self comma. + single ifFalse: [self cr]]. + self encodeKey: key value: value]]. + single ifFalse: [self cr]]. + stream nextPut: $} +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +encodeString: aString + | quote | + quote := json ifTrue: [$"] ifFalse: [$']. + stream nextPut: quote. + aString do: [:ch | self encodeCharacter: ch]. + stream nextPut: quote +! ! + +!STONWriter methodsFor: 'error handling' stamp: 'KenD 28/Jun/2026 13:27:39'! +error: aString + ^STONWriterError signal: aString +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +escape: aCharacter with: anObject + self + ASSERT: anObject isString | (anObject == #pass); + ASSERT: aCharacter codePoint < 256. + self writeableStonCharacters at: aCharacter codePoint + 1 put: anObject +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +escapeUnicode: codePoint + codePoint <= 16rFFFF ifTrue: [self escapeUnicode4: codePoint] ifFalse: [ + codePoint <= 16r10FFFF + ifTrue: [| lead trail shifted | + "Characters not in the Basic Multilingual Plane are encoded as a UTF-16 surrogate pair" + "See https://tools.ietf.org/html/rfc7159#section-7" + shifted := codePoint - 16r10000. + lead := 16rD800 + (shifted // 16r400). + trail := 16rDC00 + (shifted \\ 16r400). + self escapeUnicode4: lead; escapeUnicode4: trail] + ifFalse: [self + error: 'Character Unicode code point outside encoder range']] +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +escapeUnicode4: codePoint + | code | + stream nextPutAll: '\u'. + code := codePoint printPaddedWith: $0 to: 4 base: 16. + stream nextPutAll: code +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +indentedDo: aBlock + indent := indent + 1. + aBlock value. + indent := indent - 1 +! ! + +!STONWriter methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + stream := '' writeStream. + stonCharacters := STONCharacters. + indent := 0. + json := false. + objects := IdentityDictionary new +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSimpleSymbol: aSymbol + aSymbol isEmpty ifTrue: [^false]. + 1 to: aSymbol size do: [:i | | token | + token := STONSimpleSymbolCharacters at: (aSymbol codeAt: i) + 1. + token = 0 ifFalse: [^false]]. + ^true +! ! + +!STONWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +jsonMode: boolean + json := boolean. + json + ifTrue: [ + self + escape: $' with: #pass; + escape: $" with: '\"'] + ifFalse: [ + self + escape: $" with: #pass; + escape: $' with: '\'''] +! ! + +!STONWriter methodsFor: 'public' stamp: 'KenD 28/Jun/2026 13:27:39'! +nextPut: anObject + anObject stonOn: self +! ! + +!STONWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aWriteStream + stream := aWriteStream +! ! + +!STONWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +reset + objects removeAll +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonCharacters + ^stonCharacters ifNil: [stonCharacters := STONCharacters] +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +with: anObject do: aBlock + | index | + index := objects at: anObject ifAbsent: nil. + index isNil + ifTrue: [ + objects at: anObject put: objects size + 1. + aBlock value] + ifFalse: [ + json ifTrue: [^self error: 'shared reference detected']. + self writeReference: index] +! ! + +!STONWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeableStonCharacters + ^self stonCharacters == STONCharacters + ifTrue: [stonCharacters := stonCharacters copy] + ifFalse: [stonCharacters] +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeAssociation: anAssociation + json ifTrue: [self error: 'wrong object class for JSON mode']. + self encodeKey: anAssociation key value: anAssociation value +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeBoolean: boolean + stream print: boolean +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeFloat: float + float storeOn: stream +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeInteger: anInteger + stream print: anInteger +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeList: aCollection + self with: aCollection do: [self encodeList: aCollection] +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeMap: aDictionary + self with: aDictionary do: [self encodeMap: aDictionary] +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeNull + | token | + token := json ifTrue: ['null']. + stream print: token +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObject: anObject + | ivars | + ivars := anObject class allInstVarNames. + ivars isEmpty + ifTrue: [^self writeObject: anObject do: [self encodeMap: #()]]. + self writeObject: anObject streamMap: [:writer | + ivars do: [:ivar | + (anObject instVarNamed: ivar) + ifNotNil: [:value | writer at: ivar asSymbol put: value]]] +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObject: anObject do: aBlock + (json + and: [anObject class !!== Array] + and: [anObject class !!== STON mapClass]) + ifTrue: [self error: 'wrong object class for JSON mode']. + self with: anObject do: [| class name | + class := anObject class. + name := class isMetaclass ifTrue: ['Class'] ifFalse: [class name]. + stream nextPutAll: name; space. + aBlock value] +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObject: object listSingleton: element + self writeObject: object do: [ + stream nextPut: $[. + self nextPut: element. + stream nextPut: $]] +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObject: anObject streamMap: aBlock + self writeObject: anObject do: [| writer | + writer := STONMapWriter on: self. + stream nextPut: ${. + self indentedDo: [ + self cr. + aBlock value: writer]; cr. + stream nextPut: $}] +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeObject: anObject streamShortList: aBlock + self writeObject: anObject do: [| writer | + writer := STONStreamWriter on: self. + stream nextPut: $[. + self indentedDo: [aBlock value: writer]. + stream nextPut: $]] +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeReference: anInteger + stream nextPut: $@; print: anInteger +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeString: aString + self encodeString: aString +! ! + +!STONWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:39'! +writeSymbol: aSymbol + json ifTrue: [^self writeString: aSymbol]. + stream nextPut: $#. + (self isSimpleSymbol: aSymbol) + ifTrue: [stream nextPutAll: aSymbol] + ifFalse: [self encodeString: aSymbol] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STONWriter class' category: #STON! +STONWriter class + instanceVariableNames: 'STONCharacters STONSimpleSymbolCharacters'! + +!STONWriter class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + self initializeSTONCharacters; initializeSTONSimpleSymbolCharacters +! ! + +!STONWriter class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeSTONCharacters + STONCharacters := Array new: 127. + 32 to: 126 do: [:each | STONCharacters at: each + 1 put: #pass]. + STONCharacters + at: 9 put: '\b'; + at: 10 put: '\t'; + at: 11 put: '\n'; + at: 13 put: '\f'; + at: 14 put: '\r'; + at: 40 put: '\'''; + at: 93 put: '\\' +! ! + +!STONWriter class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeSTONSimpleSymbolCharacters + STONSimpleSymbolCharacters := ByteArray new: 256 withAll: 1. + 1 to: 256 do: [:code | | char | + char := (code - 1) asCharacter. + (self isSimpleSymbolChar: char) + ifTrue: [STONSimpleSymbolCharacters at: code put: 0]] +! ! + +!STONWriter class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +isSimpleSymbolChar: aCharacter + ^'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_./' + includes: aCharacter +! ! + +!STONWriter class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:39'! +on: aWriteStream + ^self new on: aWriteStream +! ! + + +STONWriter initialize! + diff --git a/modules/STON/STONWriterError.Class.st b/modules/STON/STONWriterError.Class.st new file mode 100644 index 00000000..fc2454a2 --- /dev/null +++ b/modules/STON/STONWriterError.Class.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! +!classDefinition: #STONWriterError category: #STON! +Error subclass: #STONWriterError + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'STON'! +!STONWriterError commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'STONWriterError class' category: #STON! +STONWriterError class + instanceVariableNames: ''! + + diff --git a/modules/STON/SequenceableCollection class.Extension.st b/modules/STON/SequenceableCollection class.Extension.st new file mode 100644 index 00000000..cc2476dd --- /dev/null +++ b/modules/STON/SequenceableCollection class.Extension.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!SequenceableCollection methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + self class == STON listClass + ifTrue: [aSTONWriter writeList: self] + ifFalse: [super stonOn: aSTONWriter] +! ! + +!SequenceableCollection class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + | references i collection | + references := OrderedCollection new. + i := 1. + collection := self streamContents: [:stream | + stonReader parseListDo: [:element | + stream nextPut: element. + element isStonReference ifTrue: [references add: {element. i}]. + i := i + 1]]. + references + do: [:ref | stonReader addElement: ref first of: collection at: ref second]. + ^collection +! ! + + diff --git a/modules/STON/String.Extension.st b/modules/STON/String.Extension.st new file mode 100644 index 00000000..26cbac72 --- /dev/null +++ b/modules/STON/String.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!String methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeString: self +! ! + + diff --git a/modules/STON/Symbol.Extension.st b/modules/STON/Symbol.Extension.st new file mode 100644 index 00000000..e41bd717 --- /dev/null +++ b/modules/STON/Symbol.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Symbol methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeSymbol: self +! ! + + diff --git a/modules/STON/Time class.Extension.st b/modules/STON/Time class.Extension.st new file mode 100644 index 00000000..509860a5 --- /dev/null +++ b/modules/STON/Time class.Extension.st @@ -0,0 +1,43 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Time methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeObject: self listSingleton: self hhmmssms +! ! + +!Time class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + ^self readFromIso8601: stonReader parseListSingleton readStream +! ! + +!Time class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +readFromIso8601: aStream + | hhmmss time ms sign hh mm offset ts | + hhmmss := aStream next: 'hh:mm:ss' size. + time := Time hhmmss: hhmmss. + ms := (aStream peekFor: $.) + ifTrue: [| f | + f := aStream upToAny: #($+ $-). + aStream skip: -1. + (('0.' , f) asNumber * 1000.0) rounded] + ifFalse: [0]. + time := Time + hours: time hours + minutes: time minutes + seconds: time seconds + milliseconds: time milliseconds + ms. + offset := (aStream peekFor: $Z) ifTrue: [0] ifFalse: [ + ('+-' includes: aStream peek) + ifTrue: [ + sign := aStream next = $+ ifTrue: [1] ifFalse: [-1]. + hh := aStream upTo: $:. + mm := aStream upToEnd. + hh asInteger * 60 + mm asInteger * sign] + ifFalse: [Timestamp localOffsetFor: Date today]]. + ts := Timestamp date: Date today time: time. + ts offset: offset. + ^ts time +! ! + + diff --git a/modules/STON/Timestamp class.Extension.st b/modules/STON/Timestamp class.Extension.st new file mode 100644 index 00000000..70ab6b67 --- /dev/null +++ b/modules/STON/Timestamp class.Extension.st @@ -0,0 +1,27 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!Timestamp methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeObject: self listSingleton: self iso8601 +! ! + +!Timestamp class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +fromSton: stonReader + ^self readFromIso8601: stonReader parseListSingleton readStream +! ! + +!Timestamp class methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +year: yyyy month: m day: dd hour: hh minute: mm second: ss offset: h + ^self + newDay: dd + month: m + year: yyyy + hours: hh + minutes: mm + seconds: ss + milliseconds: 0 + offset: h * 60 +! ! + + diff --git a/modules/STON/UndefinedObject.Extension.st b/modules/STON/UndefinedObject.Extension.st new file mode 100644 index 00000000..aa9b3f31 --- /dev/null +++ b/modules/STON/UndefinedObject.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:39 pm'! + + +!UndefinedObject methodsFor: '*STON' stamp: 'KenD 28/Jun/2026 13:27:39'! +stonOn: aSTONWriter + aSTONWriter writeNull +! ! + + diff --git a/modules/SUnit/CharacterArray.Extension.st b/modules/SUnit/CharacterArray.Extension.st new file mode 100644 index 00000000..0bcfd500 --- /dev/null +++ b/modules/SUnit/CharacterArray.Extension.st @@ -0,0 +1,19 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!CharacterArray methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitAsSymbol + ^self asSymbol +! ! + +!CharacterArray methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitMatch: aString + "Answer if there is a match starting at 1" + | n | + n := self size. + aString size < n ifTrue: [^false]. + 1 to: n do: [:i | (self at: i) == (aString at: i) ifFalse: [^false]]. + ^true. +! ! + + diff --git a/modules/SUnit/Class.Extension.st b/modules/SUnit/Class.Extension.st new file mode 100644 index 00000000..f6a91d55 --- /dev/null +++ b/modules/SUnit/Class.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!Class methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitName + ^self name asSymbol +! ! + + diff --git a/modules/SUnit/Closure.Extension.st b/modules/SUnit/Closure.Extension.st new file mode 100644 index 00000000..39cf5135 --- /dev/null +++ b/modules/SUnit/Closure.Extension.st @@ -0,0 +1,33 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!Closure methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitEnsure: terminationBlock + ^self ensure: terminationBlock +! ! + +!Closure methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitOn: exception do: handlerBlock + ^self on: exception do: handlerBlock +! ! + +!Closure methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitOn: exception1 do: handlerBlock1 on: exception2 do: handlerBlock2 + ^self sunitOn: exception1 , exception2 do: [:ex | + (ex isKindOf: exception1) + ifTrue: [handlerBlock1 evaluateWith: ex] + ifFalse: [handlerBlock2 evaluateWith: ex]] +! ! + +!Closure methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitOn: exception1 do: handlerBlock1 on: exception2 do: handlerBlock2 on: exception3 do: handlerBlock3 + ^self sunitOn: exception1 , exception2 , exception3 do: [:exception | + (exception isKindOf: exception1) + ifTrue: [handlerBlock1 evaluateWith: exception] + ifFalse: [ + (exception isKindOf: exception2) + ifTrue: [handlerBlock2 evaluateWith: exception] + ifFalse: [handlerBlock3 evaluateWith: exception]]] +! ! + + diff --git a/modules/SUnit/CompiledExpression.Extension.st b/modules/SUnit/CompiledExpression.Extension.st new file mode 100644 index 00000000..f2e9ac9f --- /dev/null +++ b/modules/SUnit/CompiledExpression.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!CompiledExpression methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +isTest + ^false +! ! + + diff --git a/modules/SUnit/CompiledMethod.Extension.st b/modules/SUnit/CompiledMethod.Extension.st new file mode 100644 index 00000000..4a1c4317 --- /dev/null +++ b/modules/SUnit/CompiledMethod.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!CompiledMethod methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +isTest + ^(class inheritsFrom: TestCase) and: [class isTestSelector: selector] +! ! + + diff --git a/modules/SUnit/Exception.Extension.st b/modules/SUnit/Exception.Extension.st new file mode 100644 index 00000000..e62f5d17 --- /dev/null +++ b/modules/SUnit/Exception.Extension.st @@ -0,0 +1,21 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!Exception methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasNextHandler + | next | + next := self nextHandler. + ^next notNil andNot: [next isSUnitHandler] +! ! + +!Exception methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitExitWith: aValue + self return: aValue +! ! + +!Exception class methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitSignalWith: aString + self signal: aString +! ! + + diff --git a/modules/SUnit/ExceptionHandler.Extension.st b/modules/SUnit/ExceptionHandler.Extension.st new file mode 100644 index 00000000..8f8fb335 --- /dev/null +++ b/modules/SUnit/ExceptionHandler.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!ExceptionHandler methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +isSUnitHandler + ^handlerBlock method selector beginsWith: 'sunit' +! ! + + diff --git a/modules/SUnit/Object.Extension.st b/modules/SUnit/Object.Extension.st new file mode 100644 index 00000000..dab14d66 --- /dev/null +++ b/modules/SUnit/Object.Extension.st @@ -0,0 +1,19 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!Object methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitAddDependent: anObject + self addDependent: anObject +! ! + +!Object methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitChanged: aspect + self changed: aspect +! ! + +!Object methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitRemoveDependent: anObject + self removeDependent: anObject +! ! + + diff --git a/modules/SUnit/SUnitModule.Class.st b/modules/SUnit/SUnitModule.Class.st new file mode 100644 index 00000000..f75abc98 --- /dev/null +++ b/modules/SUnit/SUnitModule.Class.st @@ -0,0 +1,35 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #SUnitModule category: #SUnit! +Module subclass: #SUnitModule + instanceVariableNames: 'random' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit'! +!SUnitModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(Bag CharacterArray Class Closure CompiledExpression CompiledMethod Error Exception ExceptionHandler IdentitySet Notification Species Symbol). + #Random -> #(Random) + } +! ! + +!SUnitModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + super initialize. +! ! + +!SUnitModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +random + ^random ifNil: [ random := Random new] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SUnitModule class' category: #SUnit! +SUnitModule class + instanceVariableNames: ''! + + +SUnitModule initialize! + diff --git a/modules/SUnit/SUnitNameResolver.Class.st b/modules/SUnit/SUnitNameResolver.Class.st new file mode 100644 index 00000000..c6414440 --- /dev/null +++ b/modules/SUnit/SUnitNameResolver.Class.st @@ -0,0 +1,48 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #SUnitNameResolver category: #SUnit! +Object subclass: #SUnitNameResolver + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit'! +!SUnitNameResolver commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SUnitNameResolver class' category: #SUnit! +SUnitNameResolver class + instanceVariableNames: ''! + +!SUnitNameResolver class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +classNamed: aSymbol + ^Smalltalk + at: aSymbol + ifAbsent: [nil] +! ! + +!SUnitNameResolver class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +defaultLogDevice + ^Transcript +! ! + +!SUnitNameResolver class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +errorObject + ^Error +! ! + +!SUnitNameResolver class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +mnuExceptionObject + ^MessageNotUnderstood +! ! + +!SUnitNameResolver class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +notificationObject + ^Notification +! ! + + diff --git a/modules/SUnit/Species.Extension.st b/modules/SUnit/Species.Extension.st new file mode 100644 index 00000000..9c2f5e70 --- /dev/null +++ b/modules/SUnit/Species.Extension.st @@ -0,0 +1,44 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!Species methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +selectorsUpTo: aClass + | cls | + ^Array streamContents: [:strm | + cls := self. + [ + cls notNil + ifTrue: [cls methodDictionary keysAndValuesDo: [:k :v | strm nextPut: k]]. + cls == aClass] + whileFalse: [cls := cls superclass]] +! ! + +!Species methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +selectorsUpTo: aClass satisfying: aBlock + | cls set | + set := IdentitySet new: 100. + cls := self. + [ + cls notNil ifTrue: [ + cls methodDictionary + keysAndValuesDo: [:k :v | (aBlock value: k) ifTrue: [set add: k]]]. + cls == aClass] + whileFalse: [cls := cls superclass]. + ^set +! ! + +!Species methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitAllSelectors + | answer | + answer := self superclass == Object + ifTrue: [self selectors] + ifFalse: [self superclass sunitAllSelectors addAll: self selectors; yourself]. + ^answer asOrderedCollection +! ! + +!Species methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitSelectors + ^self selectors asOrderedCollection sort +! ! + + diff --git a/modules/SUnit/Symbol.Extension.st b/modules/SUnit/Symbol.Extension.st new file mode 100644 index 00000000..c2694753 --- /dev/null +++ b/modules/SUnit/Symbol.Extension.st @@ -0,0 +1,9 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! + + +!Symbol methodsFor: '*SUnit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitAsClass + ^SUnitNameResolver classNamed: self +! ! + + diff --git a/modules/SUnit/TestCase.Class.st b/modules/SUnit/TestCase.Class.st new file mode 100644 index 00000000..d6296bfe --- /dev/null +++ b/modules/SUnit/TestCase.Class.st @@ -0,0 +1,788 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestCase category: #SUnit! +Object subclass: #TestCase + instanceVariableNames: 'testSelector testSeed time counter' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit'! +!TestCase commentStamp: '' prior: 0! + + Copyright (c) 2021-2025 Aucerna, Javier Pimás. + See (MIT) license in root directory. +! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addCountTo: aTestCounter + aTestCounter addCounter: counter! ! + +!TestCase methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:27:37'! +addDependentToHierachy: anObject + "an empty method. for Composite compability with TestSuite" +! ! + +!TestCase methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:27:37'! +addDependentToHierarchy: anObject + "an empty method. for Composite compability with TestSuite" +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +allCases + ^{self} +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +anyTest + ^self +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +assert: aBoolean + self count: #assert:; primAssert: aBoolean +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +assert: aBoolean description: aString + self + count: #assert:description:; + primAssert: aBoolean description: aString +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +assert: aBoolean description: aString resumable: resumableBoolean + self + count: #assert:description:resumable:; + primAssert: aBoolean description: aString resumable: resumableBoolean +! ! + +!TestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +assert: result equals: expected + self assert: result = expected +! ! + +!TestCase methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +basicRun: aTestResult + (aTestResult skipped includes: self) ifFalse: [aTestResult runCase: self] +! ! + +!TestCase methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +caseCount + ^1 +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +checkDescriptions + ^counter checkDescriptions +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +count: selector + counter count: selector +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +currentTest + ^self +! ! + +!TestCase methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:27:37'! +debug + self resources do: [:resource | resource beAvailableFor: self]. + [(self class selector: testSelector) runCase] + sunitEnsure: [self resources do: [:resource | resource reset]] +! ! + +!TestCase methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:27:37'! +debugAsFailure + | semaphore | + semaphore := Semaphore new. + self resources do: [:resource | resource beAvailableFor: self]. + [ + semaphore wait. + self resources do: [:resource | resource reset]] fork. + ^false + ifTrue: [(self class selector: testSelector) runCaseAsFailure: semaphore] + ifFalse: [self runCaseAsFailure: semaphore] +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +deny: aBoolean + self count: #deny:; primDeny: aBoolean +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +deny: aBoolean description: aString + self + count: #deny:description:; + primDeny: aBoolean description: aString +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +deny: aBoolean description: aString resumable: resumableBoolean + self + count: #deny:description:resumable:; + primDeny: aBoolean description: aString resumable: resumableBoolean +! ! + +!TestCase methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +executeShould: aBlock inScopeOf: anExceptionalEvent + ^[ + aBlock value. + false] + sunitOn: anExceptionalEvent + do: [:ex | ex return: true] +! ! + +!TestCase methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +executeShould: aBlock inScopeOf: anExceptionalEvent checking: exceptionBlock + ^[ + aBlock value. + false] + sunitOn: anExceptionalEvent + do: [:ex | ex return: (exceptionBlock value: ex)] +! ! + +!TestCase methodsFor: 'logging' stamp: 'KenD 28/Jun/2026 13:27:37'! +failureLog + "dialect-specific" + "VA - System errorLog" + "VW, Dolphin - Transcript" + + ^SUnitNameResolver defaultLogDevice +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +get: aspect from: anObject + ^anObject instVarNamed: aspect asString +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +importFrom: data + testSeed := data at: 4. + time := data at: 5. + counter := data at: 6 +! ! + +!TestCase methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + testSeed := self random seed. + counter := TestCounter new +! ! + +!TestCase methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isKnownIssue + | cm | + cm := self methodFor: testSelector. + ^cm notNil and: [cm includesIdentical: #knownIssue] +! ! + +!TestCase methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isLike: aTestCase + aTestCase class == self class ifFalse: [^false]. + ^aTestCase selector = self selector +! ! + +!TestCase methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isLogging + "By default, we're not logging failures. If you override this in + a subclass, make sure that you override #failureLog" + ^false +! ! + +!TestCase methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isSlow + | cm | + cm := self methodFor: testSelector. + ^cm notNil and: [cm includesIdentical: #slowTest] +! ! + +!TestCase methodsFor: 'logging' stamp: 'KenD 28/Jun/2026 13:27:37'! +logFailure: aString + self isLogging ifTrue: [ + self failureLog + cr; + nextPutAll: aString; + flush] +! ! + +!TestCase methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026 13:27:37'! +openDebuggerOnFailingTestMethod + "SUnit has halted one step in front of the failing test method. Step over the + 'self halt' and send into 'self perform: testSelector' to see the failure from + the beginning" + self performTest +! ! + +!TestCase methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +performTest + self perform: testSelector sunitAsSymbol +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +precondition: aBoolean + self assert: aBoolean description: 'Precondition for this test is not met' +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +primAssert: aBoolean + self primAssert: aBoolean description: 'Assertion failed' +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +primAssert: aBoolean description: aString + | msg | + aBoolean ifFalse: [ + msg := aString. + self isKnownIssue ifTrue: [msg := msg , ' - Known Issue']. + self logFailure: msg. + self signalFailure: msg] +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +primAssert: aBoolean description: aString resumable: rBoolean + aBoolean ifFalse: [ + self logFailure: aString. + TestResult failure sunitSignalWith: aString resumable: rBoolean] +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +primDeny: aBoolean + self primAssert: aBoolean not +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +primDeny: aBoolean description: aString + self primAssert: aBoolean not description: aString +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +primDeny: aBoolean description: aString resumable: resumableBoolean + self + primAssert: aBoolean not + description: aString + resumable: resumableBoolean +! ! + +!TestCase methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +printOn: aStream + + aStream + nextPutAll: self class printString; + nextPutAll: '>>#'; + nextPutAll: testSelector asString + +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +random + ^TestCase module random +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +removeAllSuchThat: aBlock + ^self +! ! + +!TestCase methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:27:37'! +removeDependentFromHierachy: anObject + "an empty method. for Composite compability with TestSuite" +! ! + +!TestCase methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:27:37'! +removeDependentFromHierarchy: anObject + "an empty method. for Composite compability with TestSuite" +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +resources + | all queue r | + r := self class resources. + r isEmpty ifTrue: [^r]. + all := Set new. + queue := OrderedCollection new. + queue addAll: r. + [queue isEmpty] whileFalse: [| next | + next := queue removeFirst. + all add: next. + queue addAll: next resources]. + ^all +! ! + +!TestCase methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +run + | result | + result := TestResult new. + self run: result. + ^result +! ! + +!TestCase methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +run: aTestResult + aTestResult runCase: self +! ! + +!TestCase methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +runCase + | t | + [ + t := Kernel host currentMilliseconds. + self initialize; setUp; performTest] + sunitEnsure: [self tearDown; time: Kernel host currentMilliseconds - t] +! ! + +!TestCase methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +runCaseAsFailure: aSemaphore + [self setUp; openDebuggerOnFailingTestMethod] sunitEnsure: [ + self tearDown. + aSemaphore signal] +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +seed + ^testSeed +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +selector + ^testSelector isMessage + ifTrue: [testSelector selector] + ifFalse: [testSelector] +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +set: aspect of: anObject to: value + anObject instVarNamed: aspect asString put: value +! ! + +!TestCase methodsFor: 'set up' stamp: 'KenD 28/Jun/2026 13:27:37'! +setUp + | file | + self random seed: testSeed. + counter reset +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +should: aBlock + self count: #should:. + self primAssert: aBlock value +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +should: aBlock description: aString + self count: #should:description:. + self primAssert: aBlock value description: aString +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +should: aBlock raise: anExceptionalEvent + self count: #should:raise:. + ^self primAssert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +should: aBlock raise: anExceptionalEvent description: aString + self count: #should:raise:description:. + ^self + primAssert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) + description: aString +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +should: aBlock raise: anExceptionalEvent description: aString resumable: aBoolean + | raised | + self count: #should:raise:description:. + raised := false. + [ + aBlock value. + false] + sunitOn: anExceptionalEvent + do: [:ex | + raised := true. + ex isResumable ifTrue: [ex resume] ifFalse: [ex return]]. + ^self + primAssert: raised + description: aString + resumable: aBoolean +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +should: aBlock raise: anExceptionalEvent satisfying: exceptionBlock + self count: #should:raise:. + ^self + primAssert: (self + executeShould: aBlock + inScopeOf: anExceptionalEvent + checking: exceptionBlock) +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +should: aBlock raise: anExceptionalEvent satisfying: exceptionBlock description: aString + self count: #should:raise:description:. + ^self + primAssert: (self + executeShould: aBlock + inScopeOf: anExceptionalEvent + checking: exceptionBlock) + description: aString +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +should: aBlock send: aSymbol to: anObject + ^self + should: aBlock + send: aSymbol + to: anObject + description: aSymbol , ' should have been sent' +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +should: aBlock send: aSymbol to: anObject description: aString + | sent | + sent := false. + anObject whenReceiving: aSymbol evaluate: [:msg | sent := true]. + aBlock ensure: [anObject stopSpying: aSymbol]. + self assert: sent description: aString +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock + self count: #shouldnt:; primDeny: aBlock value +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock description: aString + self + count: #shouldnt:description:; + primDeny: aBlock value description: aString +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock raise: anExceptionalEvent + ^self + count: #shouldnt:raise:; + primDeny: (self executeShould: aBlock inScopeOf: anExceptionalEvent) +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock raise: anExceptionalEvent description: aString + ^self + count: #shouldnt:raise:description:; + primDeny: (self executeShould: aBlock inScopeOf: anExceptionalEvent) + description: aString +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: testBlock raise: anExceptionalEvent description: aString ensure: aBlock + ^[self shouldnt: testBlock raise: anExceptionalEvent description: aString] + ensure: aBlock +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock raise: anExceptionalEvent description: aString resumable: aBoolean + ^self + count: #shouldnt:raise:description:; + primDeny: (self executeShould: aBlock inScopeOf: anExceptionalEvent) + description: aString + resumable: aBoolean +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock raise: anExceptionalEvent otherwise: exceptionBlock + ^self + count: #shouldnt:raise:; + primDeny: (self + executeShould: aBlock + inScopeOf: anExceptionalEvent + checking: exceptionBlock) +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock raise: anExceptionalEvent satisfying: exceptionBlock description: aString + self count: #shouldnt:raise:description:. + ^self + primDeny: (self + executeShould: aBlock + inScopeOf: anExceptionalEvent + checking: exceptionBlock) + description: aString +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock send: aSymbol moreThan: anInteger timesTo: anObject + self + shouldnt: aBlock + send: aSymbol + moreThan: anInteger + timesTo: anObject + description: 'Possible stack overflow' +! ! + +!TestCase methodsFor: 'denying' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock send: aSymbol moreThan: anInteger timesTo: anObject description: aString + | count | + count := 0. + anObject whenReceiving: aSymbol evaluate: [:msg | + count := count + 1. + self assert: count <= anInteger description: aString]. + aBlock ensure: [anObject stopSpying: aSymbol] +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock send: aSymbol to: anObject + ^self + shouldnt: aBlock + send: aSymbol + to: anObject + description: aSymbol storeString , ' should not be sent to ' + , anObject printString +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock send: aSymbol to: anObject description: aString + anObject + whenReceiving: aSymbol + evaluate: [:msg | self deny: true description: aString]. + aBlock ensure: [anObject stopSpying: aSymbol] +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock takeMoreThan: milliseconds + self + shouldnt: aBlock + takeMoreThan: milliseconds + description: 'Too long time to perform this task' +! ! + +!TestCase methodsFor: 'asserting' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldnt: aBlock takeMoreThan: milliseconds description: aString + | semaphore process | + semaphore := Semaphore new. + process := [ + aBlock value. + semaphore signal] + forkAt: Processor userBackgroundPriority. + [semaphore waitForAtMost: milliseconds] on: Timeout do: [ + process terminate. + self assert: false print description: aString]. + self assert: true +! ! + +!TestCase methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +signalFailure: aString + TestResult failure sunitSignalWith: aString +! ! + +!TestCase methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +signalSkipped: aString + TestResult skipped sunitSignalWith: aString +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +signature + ^self suite name -> self class name -> testSelector +! ! + +!TestCase methodsFor: 'skipping' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipIf: aBoolean description: aString + aBoolean ifTrue: [self signalSkipped: aString] +! ! + +!TestCase methodsFor: 'compatibility' stamp: 'KenD 28/Jun/2026 13:27:37'! +stop: aBoolean +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +suite + ^self propertyAt: #suite +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +suite: aTestSuite + self propertyAt: #suite put: aTestSuite +! ! + +!TestCase methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +tearDown + +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +tests + ^{self} +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +testSelector: aSymbol + testSelector := aSymbol +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +time + ^time +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +time: anInteger + time := anInteger +! ! + +!TestCase methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +totalChecks + ^counter totalChecks +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestCase class' category: #SUnit! +TestCase class + instanceVariableNames: ''! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +allTestSelectors + ^(self + selectorsUpTo: self rootClass + satisfying: [:selector | self isTestSelector: selector]) asOrderedCollection sort +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +buildSuiteFromAllSelectors + ^self buildSuiteFromMethods: self allTestSelectors +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +buildSuiteFromLocalSelectors + ^self buildSuiteFromMethods: self testSelectors +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +buildSuiteFromMethods: aCollection + | suite | + suite := self newSuite. + self shouldBuildForSubclasses + ifTrue: [ + self allSubclasses reject: #shouldIgnoreTestClass thenDo: [:c | | s | + s := c buildSuiteFromMethods: aCollection. + suite addTest: s]] + ifFalse: [ + aCollection do: [:selector | | test | + test := self selector: selector. + suite addTest: test]]. + ^suite +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +buildSuiteFromSelectors + self shouldIgnoreTestClass ifTrue: [^self newSuite]. + ^self shouldInheritSelectors + ifTrue: [self buildSuiteFromAllSelectors] + ifFalse: [self buildSuiteFromLocalSelectors] +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +buildTestSuite + | suite | + ^self isAbstract + ifTrue: [ + suite := self newSuite. + self allSubclasses + do: [:cls | cls isAbstract + ifFalse: [suite addTest: cls buildSuiteFromSelectors]]. + suite] + ifFalse: [self buildSuiteFromSelectors] +! ! + +!TestCase class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +debug: aSymbol + ^(self selector: aSymbol) debug +! ! + +!TestCase class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isAbstract + ^self sunitName = #TestCase +! ! + +!TestCase class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isTestSelector: aSymbol + aSymbol == #tests ifTrue: [^false]. + ^(self selectorPatterns + anySatisfy: [:pattern | pattern sunitMatch: aSymbol]) + and: [aSymbol last !!= $:] +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +newSuite + ^self suiteClass named: self name asString +! ! + +!TestCase class methodsFor: 'resources' stamp: 'KenD 28/Jun/2026 13:27:37'! +resources + ^#() +! ! + +!TestCase class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +rootClass + ^TestCase +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +run: aSymbol + ^(self selector: aSymbol) run +! ! + +!TestCase class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +selector: aSymbol + ^self new testSelector: aSymbol +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +selectorPattern + ^'test' +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +selectorPatterns + ^#('test' 'devTest') +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldBuildForSubclasses + ^self isAbstract +! ! + +!TestCase class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldIgnoreTestClass + ^self isAbstract +! ! + +!TestCase class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldInheritSelectors + ^self superclass isAbstract or: [self testSelectors isEmpty] +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +suite + ^self buildTestSuite +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +suiteClass + ^TestSuite + +! ! + +!TestCase class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitVersion + ^'3.1' + +! ! + +!TestCase class methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +testSelectors + ^self sunitSelectors select: [:each | + (self selectorPatterns anySatisfy: [:pattern | pattern sunitMatch: each]) + and: [each last ~= $:]] +! ! + + +TestCase initialize! + diff --git a/modules/SUnit/TestCounter.Class.st b/modules/SUnit/TestCounter.Class.st new file mode 100644 index 00000000..a3197759 --- /dev/null +++ b/modules/SUnit/TestCounter.Class.st @@ -0,0 +1,74 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestCounter category: #SUnit! +Object subclass: #TestCounter + instanceVariableNames: 'checks' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit'! +!TestCounter commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!TestCounter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addCounter: aTestCounter + checks addAll: aTestCounter checks +! ! + +!TestCounter methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +checkDescriptions + | description stream | + description := OrderedCollection new. + checks withOccurrencesDo: [:selector :total | + stream := '' writeStream. + stream + nextPutAll: ' > '; + print: selector; + space; + print: total. + description add: stream contents]. + ^description +! ! + +!TestCounter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +checks + ^checks +! ! + +!TestCounter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +count: aspect + checks add: aspect +! ! + +!TestCounter methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + super initialize. + checks := Bag new +! ! + +!TestCounter methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:37'! +occurrencesOf: aSymbol + ^checks occurrencesOf: aSymbol +! ! + +!TestCounter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +reset + checks removeAll +! ! + +!TestCounter methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:37'! +totalChecks + ^checks size +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestCounter class' category: #SUnit! +TestCounter class + instanceVariableNames: ''! + + +TestCounter initialize! + diff --git a/modules/SUnit/TestFailure.Class.st b/modules/SUnit/TestFailure.Class.st new file mode 100644 index 00000000..c534bcc9 --- /dev/null +++ b/modules/SUnit/TestFailure.Class.st @@ -0,0 +1,36 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestFailure category: #SUnit! +Exception subclass: #TestFailure + instanceVariableNames: 'resumable' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit'! +!TestFailure commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!TestFailure methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isResumable + ^resumable notNil and: [resumable] +! ! + +!TestFailure methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +resumable: aBoolean + resumable := aBoolean +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestFailure class' category: #SUnit! +TestFailure class + instanceVariableNames: ''! + +!TestFailure class methodsFor: 'sunit' stamp: 'KenD 28/Jun/2026 13:27:37'! +sunitSignalWith: aString resumable: aBoolean + ^self new description: aString; resumable: aBoolean; signal +! ! + + diff --git a/modules/SUnit/TestResource.Class.st b/modules/SUnit/TestResource.Class.st new file mode 100644 index 00000000..64dd0927 --- /dev/null +++ b/modules/SUnit/TestResource.Class.st @@ -0,0 +1,142 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestResource category: #SUnit! +Object subclass: #TestResource + instanceVariableNames: 'name description' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit'! +!TestResource commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!TestResource methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +beAvailable + self isAvailable ifFalse: [self signalInitializationError] +! ! + +!TestResource methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +beAvailableFor: aTestSuite + self beAvailable +! ! + +!TestResource methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description + description isNil ifTrue: [^'']. + ^description +! ! + +!TestResource methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description: aString + description := aStrin +! ! + +!TestResource methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + self setUp +! ! + +!TestResource methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isAvailable + ^true +! ! + +!TestResource methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isUnavailable + ^self isAvailable not +! ! + +!TestResource methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name + name isNil ifTrue: [^self printString]. + ^name +! ! + +!TestResource methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name: aString + name := aString +! ! + +!TestResource methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +printOn: aStream + aStream nextPutAll: self class printString +! ! + +!TestResource methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +resources + ^self class resources +! ! + +!TestResource methodsFor: 'set up' stamp: 'KenD 28/Jun/2026 13:27:37'! +setUp +! ! + +!TestResource methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +signalInitializationError + ^self class signalInitializationError +! ! + +!TestResource methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:37'! +tearDown +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestResource class' category: #SUnit! +TestResource class + instanceVariableNames: ''! + +!TestResource class methodsFor: 'pm support' stamp: 'KenD 28/Jun/2026 13:27:37'! +aboutToSaveLibraryOn: aCodeSegmentBuilder + aCodeSegmentBuilder map: current to: nil +! ! + +!TestResource class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +beAvailableFor: aTestSuite + ^self current notNil and: [self current beAvailableFor: aTestSuite] +! ! + +!TestResource class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +current + current isNil ifTrue: [current := self new]. + ^current +! ! + +!TestResource class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +current: aTestResource + current := aTestResource +! ! + +!TestResource class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isAbstract + "Override to true if a TestResource subclass is Abstract and should not have TestCase + instances built from it" + ^self name = 'TestResource' +! ! + +!TestResource class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isUnavailable + ^self isAvailable not +! ! + +!TestResource class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +reset + current notNil ifTrue: [[current tearDown] ensure: [current := nil]] +! ! + +!TestResource class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +resources + ^#() +! ! + +!TestResource class methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +signalInitializationError + ^TestResult + signalErrorWith: 'Resource ' , self name , ' could not be initialized' +! ! + + +TestResource initialize! + diff --git a/modules/SUnit/TestResult.Class.st b/modules/SUnit/TestResult.Class.st new file mode 100644 index 00000000..588924fa --- /dev/null +++ b/modules/SUnit/TestResult.Class.st @@ -0,0 +1,381 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestResult category: #SUnit! +Object subclass: #TestResult + instanceVariableNames: 'failures errors passed skipped' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit'! +!TestResult commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!TestResult methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:37'! +addAll: aTestResult + self failures addAll: aTestResult failures. + self errors addAll: aTestResult errors. + self passed addAll: aTestResult passed. + self skipped addAll: aTestResult skipped +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +caseCount + ^self runCount + self skippedCount +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +defects + ^OrderedCollection new + addAll: (self errors asArray sortBy: #printString); + addAll: (self failures asArray sortBy: #printString); + addAll: (self skipped asArray sortBy: #printString); + yourself +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +errorCount + ^self errors size +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +errors + errors isNil ifTrue: [errors := OrderedCollection new]. + ^errors +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +errors: aCollection + errors := aCollection +! ! + +!TestResult methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:37'! +export + ^Dictionary + withAll: {#failures -> (self failures collect: #export). + #errors -> (self errors collect: #export). + #passed -> (self passed collect: #export). + #skipped -> (self skipped collect: #export)} +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +failureCount + ^self failures size +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +failures + failures isNil ifTrue: [failures := OrderedCollection new]. + ^failures +! ! + +!TestResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasDefects + ^self hasErrors or: [failures anySatisfy: [:test | test isKnownIssue not]] +! ! + +!TestResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasErrors + ^self errors size > 0 +! ! + +!TestResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasFailures + ^self failures size > 0 +! ! + +!TestResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasPassed + ^self hasErrors not and: [self hasFailures not] +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +ignoreErrors: aBlock + errors notNil ifTrue: [errors removeAllSuchThat: aBlock] +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +ignoreFailures: aBlock + failures notNil ifTrue: [failures removeAllSuchThat: aBlock] +! ! + +!TestResult methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:37'! +importAll: exported using: aTestSuite + | all | + all := aTestSuite allCases. + exported keysAndValuesDo: [:name :contents | | imported collection | + imported := contents collect: [:data | | classname selector found | + classname := data at: 1. + selector := data at: 2. + found := all + detect: [:case | case selector = selector + and: [case class name = classname]]. + found importFrom: data]. + collection := self perform: name. + collection addAll: imported] +! ! + +!TestResult methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize +! ! + +!TestResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isError: aTestCase + ^self errors includes: aTestCase +! ! + +!TestResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isFailure: aTestCase + ^self failures includes: aTestCase +! ! + +!TestResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isPassed: aTestCase + ^self passed includes: aTestCase +! ! + +!TestResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isSkipped: aTestCase + ^self skipped includes: aTestCase +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +knownErrors + ^self errors select: [:f | f isKnownIssue] +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +knownFailures + ^self failures select: [:f | f isKnownIssue] +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +knownIssues + ^self knownFailures , self knownErrors +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +passed + passed isNil ifTrue: [passed := OrderedCollection new]. + ^passed +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +passedCount + ^self passed size +! ! + +!TestResult methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +printOn: aStream + self printStatisticsOn: aStream +! ! + +!TestResult methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +printStatisticsOn: aStream + | kf ke k f e | + kf := self knownFailures size. + ke := self knownErrors size. + k := kf + ke. + f := self failureCount - kf. + e := self errorCount - ke. + aStream + nextPutAll: self runCount printString; + nextPutAll: ' run, '; + nextPutAll: self passedCount printString; + nextPutAll: ' passed, '; + nextPutAll: f printString; + nextPutAll: ' failed, '; + nextPutAll: self skippedCount printString; + nextPutAll: ' skipped, '. + k > 0 ifTrue: [aStream print: k; nextPutAll: ' known issues, ']. + aStream print: e; nextPutAll: ' error'. + e !!= 1 ifTrue: [aStream nextPut: $s]. + e + f > 0 ifTrue: [aStream cr]. + f > 0 ifTrue: [ + aStream nextPutAll: 'Failures:'; cr. + self unknownFailures do: [:failure | aStream print: failure; cr]]. + e > 0 ifTrue: [ + aStream nextPutAll: 'Errors:'; cr. + self unknownErrors do: [:error | aStream print: error; cr]]. +! ! + +!TestResult methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +runCase: aTestCase + | success t | + success := [ + t := Kernel host currentMilliseconds. + aTestCase runCase; time: Kernel host currentMilliseconds - t. + true] + sunitOn: self class failure + do: [:signal | + aTestCase time: Kernel host currentMilliseconds - t. + self failures add: aTestCase. + signal sunitExitWith: false] + on: self class skipped + do: [:signal | + aTestCase time: Kernel host currentMilliseconds - t. + self skipped add: aTestCase. + signal sunitExitWith: false] + on: self class error + do: [:signal | + aTestCase time: Kernel host currentMilliseconds - t. + self errors add: aTestCase. + signal sunitExitWith: false]. + success ifTrue: [self passed add: aTestCase] +! ! + +!TestResult methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +runCaseAsError: aTestCase + | new | + self errors add: aTestCase. + new := aTestCase debugAsFailure. + self errors remove: aTestCase. + self passed add: new +! ! + +!TestResult methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +runCaseAsFailure: aTestCase + | new | + self failures add: aTestCase. + new := aTestCase debugAsFailure. + self failures remove: aTestCase. + self passed add: new +! ! + +!TestResult methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +runCaseRefresh: aTestCase + | failure error | + failure := self isFailure: aTestCase. + error := self isError: aTestCase. + self passed remove: aTestCase ifAbsent: nil. + self failures remove: aTestCase ifAbsent: nil. + self errors remove: aTestCase ifAbsent: nil. + failure ifTrue: [self runCaseAsFailure: aTestCase] ifFalse: [ + error + ifTrue: [self runCaseAsError: aTestCase] + ifFalse: [self runCase: aTestCase]] +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +runCount + ^self passedCount + self failureCount + self errorCount +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipAll: cases + | s e | + s := self skipped. + cases do: [:case | s addIfAbsent: case] +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipped + skipped isNil ifTrue: [skipped := OrderedCollection new]. + ^skipped +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +skippedCount + ^self skipped size +! ! + +!TestResult methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +stateFor: aTestCase + | answer | + (self isPassed: aTestCase) ifTrue: [answer := 'Pass']. + (self isFailure: aTestCase) ifTrue: [answer := 'Failure']. + (self isError: aTestCase) ifTrue: [answer := 'Error']. + (self isSkipped: aTestCase) ifTrue: [answer := 'Skipped']. + aTestCase isKnownIssue ifTrue: [answer := answer , ' (known)']. + ^answer +! ! + +!TestResult methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:37'! +takeOut: aTestResult + self failures removeAll: aTestResult failures ifAbsent: nil. + self errors removeAll: aTestResult errors ifAbsent: nil. + self passed removeAll: aTestResult passed +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +tests + ^(OrderedCollection new: self runCount) + addAll: self passed; + addAll: self errors; + addAll: self failures; + addAll: self skipped; + yourself +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +totalCases + ^self passedCount + self failureCount + self errorCount +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +totalChecks + ^self tests sum: [:test | test totalChecks] ifNone: 0 +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +totalTime + ^(self passed sum: [:testCase | testCase time] ifNone: [0]) + + (self failures sum: [:testCase | testCase time] ifNone: [0]) + + (self errors sum: [:testCase | testCase time] ifNone: [0]) +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +unknownErrors + ^self errors reject: [:f | f isKnownIssue] +! ! + +!TestResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +unknownFailures + ^self failures reject: [:f | f isKnownIssue] +! ! + +!TestResult methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:37'! +withAll: aTestResult + self addAll: aTestResult +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestResult class' category: #SUnit! +TestResult class + instanceVariableNames: ''! + +!TestResult class methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +error + ^self exError +! ! + +!TestResult class methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +exError + ^SUnitNameResolver errorObject +! ! + +!TestResult class methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +failure + ^TestFailure +! ! + +!TestResult class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +signalErrorWith: aString + self error sunitSignalWith: aString +! ! + +!TestResult class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:37'! +signalFailureWith: aString + self failure sunitSignalWith: aString +! ! + +!TestResult class methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipped + ^TestSkipped +! ! + + +TestResult initialize! + diff --git a/modules/SUnit/TestSkipped.Class.st b/modules/SUnit/TestSkipped.Class.st new file mode 100644 index 00000000..96748703 --- /dev/null +++ b/modules/SUnit/TestSkipped.Class.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestSkipped category: #SUnit! +Notification subclass: #TestSkipped + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit'! +!TestSkipped commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!TestSkipped methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isResumable + ^false +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestSkipped class' category: #SUnit! +TestSkipped class + instanceVariableNames: ''! + + diff --git a/modules/SUnit/TestSuite.Class.st b/modules/SUnit/TestSuite.Class.st new file mode 100644 index 00000000..8832bb01 --- /dev/null +++ b/modules/SUnit/TestSuite.Class.st @@ -0,0 +1,309 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestSuite category: #SUnit! +Object subclass: #TestSuite + instanceVariableNames: 'tests resources name view current stop' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit'! +!TestSuite commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addDependent: anObject + self when: #changed send: #update to: anObject +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addDependentToHierachy: anObject + self addDependent: anObject. + self tests do: [:each | each addDependentToHierachy: anObject] +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addDependentToHierarchy: anObject + self addDependent: anObject. + self tests do: [:each | each addDependentToHierarchy: anObject] +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addTest: test + test suite: self. + self tests add: test +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addTests: aCollection + aCollection do: [:test | self addTest: test] +! ! + +!TestSuite methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +allCases + ^self tests gather: [:test | test allCases] +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +anyTest + tests isNil ifTrue: [^nil]. + tests isEmpty ifTrue: [^nil]. + ^tests anyone anyTest +! ! + +!TestSuite methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +basicRun: aTestResult + self tests do: [:test | + self run: test result: aTestResult] +! ! + +!TestSuite methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +caseCount + ^self tests sum: #caseCount +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +currentTest + ^current notNil ifTrue: [current currentTest] +! ! + +!TestSuite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +defaultResources + | default | + default := Dictionary new. + self tests do: [:test | + test resources do: [:resource | | users | + users := default at: resource ifAbsentPut: [OrderedCollection new]. + users add: test]]. + ^default +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +innerSuites + ^tests isNil + ifTrue: [#()] + ifFalse: [tests select: [:t | t isKindOf: TestSuite]] +! ! + +!TestSuite methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isLike: aTestSuite + aTestSuite class == self class ifFalse: [^false]. + ^aTestSuite name = name +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name + ^name +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name: aString + name := aString +! ! + +!TestSuite methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +printOn: aStream + name isNil ifTrue: [^super printOn: aStream]. + aStream + nextPutAll: self class name; + nextPutAll: ' for '; + nextPutAll: name +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +removeAllSuchThat: aBlock + tests isNil ifTrue: [^self]. + tests removeAllSuchThat: aBlock. + tests do: [:test | test removeAllSuchThat: aBlock] +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +removeDependentFromHierachy: anObject + self removeDependent: anObject. + self tests do: [:each | each removeDependentFromHierachy: anObject] +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +removeDependentFromHierarchy: anObject + self removeDependent: anObject. + self tests do: [:each | each removeDependentFromHierarchy: anObject] +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +removeTests: aCollection + self + removeAllSuchThat: [:t | aCollection anySatisfy: [:test | test isLike: t]] +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +resources + resources isNil ifTrue: [resources := self defaultResources]. + ^resources keys +! ! + +!TestSuite methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +resultChanged: aTestResult + "self triggerEvent: #resultChanged: with: aTestResult" +! ! + +!TestSuite methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +run + | result | + result := TestResult new. + self run: result. + ^result +! ! + +!TestSuite methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +runDebug + | res | + res := self resources. + res do: [:resource | resource beAvailableFor: self]. + [ + self allCases do: [:test | + Kernel log: 'running ', test printString; log: String cr. + test runCase]] + sunitEnsure: [res do: [:resource | resource reset]] +! ! + +!TestSuite methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +run: aTestResult + | res | + res := self setUpResources: aTestResult. + [ + stop == true ifTrue: [^self]. + self basicRun: aTestResult] + sunitEnsure: [res do: [:resource | resource reset]] +! ! + +!TestSuite methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +run: test result: aTestResult + current := test. +" self changed: self." + stop == true ifTrue: [^self]. + (test isKindOf: TestSuite) ifTrue: [ + "test + when: #changed: send: #changed: to: self; + when: #resultChanged: send: #resultChanged: to: self"]. + test basicRun: aTestResult. + self resultChanged: aTestResult +! ! + +!TestSuite methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +setUpResources: aTestResult + | res | + res := [self resources] on: Error do: [ + aTestResult skipAll: self allCases. + {}]. + res do: [:resource | + [resource beAvailableFor: self] + on: Error + do: [self skipTestsUsing: resource in: aTestResult]]. + ^res +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +size + ^tests isNil + ifTrue: [0] + ifFalse: [tests + sum: [:t | (t isKindOf: TestCase) ifTrue: [1] ifFalse: [t size]]] +! ! + +!TestSuite methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipTestsUsing: aResource in: aTestResult + | users | + users := resources at: aResource. + users do: [:test | aTestResult skipAll: test allCases] +! ! + +!TestSuite methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +stop + self stop: true +! ! + +!TestSuite methodsFor: 'running' stamp: 'KenD 28/Jun/2026 13:27:37'! +stop: aBoolean + stop := aBoolean. + tests notNil ifTrue: [tests do: [:suite | suite stop: aBoolean]] +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +suite + ^self +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +suite: aTestSuite + " + Do nothing, compatibility with TestCase + " +! ! + +!TestSuite methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +tests + tests isNil ifTrue: [tests := OrderedCollection new]. + ^tests + +! ! + +!TestSuite methodsFor: 'exceptions' stamp: 'KenD 28/Jun/2026 13:27:37'! +uniqueCaseCount + | signatures | + signatures := self allCases collect: #signature. + ^signatures withoutDuplicates size +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestSuite class' category: #SUnit! +TestSuite class + instanceVariableNames: ''! + +!TestSuite class methodsFor: 'events' stamp: 'KenD 28/Jun/2026 13:27:37'! +availableEvents + ^super availableEvents add: #resultChanged:; yourself +! ! + +!TestSuite class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +forModule: aModule + | suite | + suite := self named: aModule name. + aModule classes do: [:cls | + (cls inheritsFrom: TestCase) ifTrue: [ + suite addTest: cls buildTestSuite]]. + ^suite +! ! + +!TestSuite class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +fromString: aString + | suite cm | + suite := self named: 'From strings'. + aString lines do: [:line | + cm := CompiledMethod fromSignature: line withoutSeparators. + suite addTest: (cm classBinding selector: cm selector)]. + ^suite +! ! + +!TestSuite class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +named: aString + ^self new name: aString; yourself +! ! + +!TestSuite class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +named: aString with: objects + | tests | + tests := objects collect: [:o | + o isClass ifTrue: [o buildSuiteFromSelectors] ifFalse: [ + self ASSERT: o isAssociation. + o key buildSuiteFromMethods: {o value}]]. + ^self named: aString withTests: tests +! ! + +!TestSuite class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +named: aString withTests: aCollection + ^self new name: aString; addTests: aCollection +! ! + + diff --git a/modules/SUnit/Tests/ExampleSetTest.Class.st b/modules/SUnit/Tests/ExampleSetTest.Class.st new file mode 100644 index 00000000..833eb61e --- /dev/null +++ b/modules/SUnit/Tests/ExampleSetTest.Class.st @@ -0,0 +1,70 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ExampleSetTest category: #'SUnit.Tests'! +TestCase subclass: #ExampleSetTest + instanceVariableNames: 'full empty' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit.Tests'! +!ExampleSetTest commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!ExampleSetTest methodsFor: 'set up' stamp: 'KenD 28/Jun/2026 13:27:37'! +setUp + empty := Set new. + full := Set with: 5 with: #abc +! ! + +!ExampleSetTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testAdd + empty add: 5. + self assert: (empty includes: 5) +! ! + +!ExampleSetTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testGrow + empty addAll: (1 to: 100). + self assert: empty size = 100 +! ! + +!ExampleSetTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testIllegal + self + should: [empty at: 5] + raise: TestResult error. + self + should: [empty at: 5 put: #abc] + raise: TestResult error +! ! + +!ExampleSetTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testIncludes + self assert: (full includes: 5). + self assert: (full includes: #abc) +! ! + +!ExampleSetTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testOccurrences + self assert: (empty occurrencesOf: 0) = 0. + self assert: (full occurrencesOf: 5) = 1. + full add: 5. + self assert: (full occurrencesOf: 5) = 1 +! ! + +!ExampleSetTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testRemove + full remove: 5. + self assert: (full includes: #abc). + self deny: (full includes: 5) +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ExampleSetTest class' category: #'SUnit.Tests'! +ExampleSetTest class + instanceVariableNames: ''! + + diff --git a/modules/SUnit/Tests/ResumableTestFailureTestCase.Class.st b/modules/SUnit/Tests/ResumableTestFailureTestCase.Class.st new file mode 100644 index 00000000..ce53c0a3 --- /dev/null +++ b/modules/SUnit/Tests/ResumableTestFailureTestCase.Class.st @@ -0,0 +1,77 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #ResumableTestFailureTestCase category: #'SUnit.Tests'! +TestCase subclass: #ResumableTestFailureTestCase + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit.Tests'! +!ResumableTestFailureTestCase commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!ResumableTestFailureTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +errorTest + 1 zork +! ! + +!ResumableTestFailureTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +failureLog + ^SUnitNameResolver defaultLogDevice +! ! + +!ResumableTestFailureTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +failureTest + self + assert: false description: 'You should see me' resumable: true; + assert: false description: 'You should see me too' resumable: true; + assert: false description: 'You should see me last' resumable: false; + assert: false description: 'You should not see me' resumable: true +! ! + +!ResumableTestFailureTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +isLogging + ^false +! ! + +!ResumableTestFailureTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +okTest + self assert: true +! ! + +!ResumableTestFailureTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +regularTestFailureTest + self assert: false description: 'You should see me' +! ! + +!ResumableTestFailureTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +resumableTestFailureTest + self + assert: false description: 'You should see me' resumable: true; + assert: false description: 'You should see me too' resumable: true; + assert: false description: 'You should see me last' resumable: false; + assert: false description: 'You should not see me' resumable: true +! ! + +!ResumableTestFailureTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +testResumable + | result suite | + suite := TestSuite new. + suite addTest: (self class selector: #errorTest). + suite addTest: (self class selector: #regularTestFailureTest). + suite addTest: (self class selector: #resumableTestFailureTest). + suite addTest: (self class selector: #okTest). + result := suite run. + self assert: result failures size = 2; + assert: result errors size = 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'ResumableTestFailureTestCase class' category: #'SUnit.Tests'! +ResumableTestFailureTestCase class + instanceVariableNames: ''! + + diff --git a/modules/SUnit/Tests/SUnitTest.Class.st b/modules/SUnit/Tests/SUnitTest.Class.st new file mode 100644 index 00000000..0af397b2 --- /dev/null +++ b/modules/SUnit/Tests/SUnitTest.Class.st @@ -0,0 +1,306 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #SUnitTest category: #'SUnit.Tests'! +TestCase subclass: #SUnitTest + instanceVariableNames: 'hasRun hasSetup hasRanOnce' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit.Tests'! +!SUnitTest commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!SUnitTest methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +error + 3 zork +! ! + +!SUnitTest methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +errorShouldntRaise + self + shouldnt: [self someMessageThatIsntUnderstood] + raise: SUnitNameResolver notificationObject +! ! + +!SUnitTest methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +fail + self assert: false +! ! + +!SUnitTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasRun + ^hasRun +! ! + +!SUnitTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasSetup + ^hasSetup +! ! + +!SUnitTest methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +noop +! ! + +!SUnitTest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +setRun + hasRun := true +! ! + +!SUnitTest methodsFor: 'set up' stamp: 'KenD 28/Jun/2026 13:27:37'! +setUp + super setUp. + hasSetup := true +! ! + +!SUnitTest methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +skip + self skipIf: true description: 'this test is skipped' +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testAssert + self assert: true; deny: false +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +log: message + Kernel log: message, String cr +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testCounter + | assert deny shouldnt description | + assert := counter occurrencesOf: #assert:. + deny := counter occurrencesOf: #deny:. + shouldnt := counter occurrencesOf: #shouldnt:raise:. + description := counter occurrencesOf: #assert:description:. + self + assert: true; + assert: assert + 1 = (counter occurrencesOf: #assert:) + description: 'Failure counting asserts'; + deny: false; + assert: deny + 1 = (counter occurrencesOf: #deny:) + description: 'Failure counting denys'; + shouldnt: [] raise: Error; + assert: shouldnt + 1 = (counter occurrencesOf: #shouldnt:raise:) + description: 'Failure counting #shouldnt:raise:'; + assert: description + 3 = (counter occurrencesOf: #assert:description:) +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testDefects + | error failure suite result | + error := self class selector: #error. + failure := self class selector: #fail. + suite := TestSuite new. + suite addTest: error; addTest: failure. + result := suite run. + self + assert: result defects asArray = (Array with: error with: failure); + assert: result runCount = 2; + assert: result passedCount = 0; + assert: result failureCount = 1; + assert: result errorCount = 1 +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testDialectLocalizedException + self + should: [TestResult signalFailureWith: 'Foo'] + raise: TestResult failure. + self should: [TestResult signalErrorWith: 'Foo'] raise: TestResult error +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testError + | case result | + case := self class selector: #error. + result := case run. + self + assert: result runCount = 1; + assert: result passedCount = 0; + assert: result failureCount = 0; + assert: result errorCount = 1. + case := self class selector: #errorShouldntRaise. + result := case run. + self + assert: result runCount = 1; + assert: result passedCount = 0; + assert: result failureCount = 0; + assert: result errorCount = 1 +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testException + self should: [self error: 'foo'] raise: TestResult error +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testFail + | case result | + case := self class selector: #fail. + result := case run. + self + assert: result runCount = 1; + assert: result passedCount = 0; + assert: result failureCount = 1; + assert: result errorCount = 0 +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testIsNotRerunOnDebug + | case | + case := self class selector: #testRanOnlyOnce. + case run. + case debug +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testRan + | case | + case := self class selector: #setRun. + case run. + self assert: case hasSetup. + self assert: case hasRun +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testRandomGenerator + | seed | + seed := self random seed. + self random next. + self deny: self random seed = seed +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testRanOnlyOnce + self assert: hasRanOnce ~= true. + hasRanOnce := true +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testRemoveTests + | suite inner | + suite := TestSuite new. + inner := TestSuite named: 'inner'. + inner + addTest: (TestCase selector: #a); + addTest: (TestCase selector: #b). + suite + addTest: inner; + addTest: (TestCase selector: #c). + suite removeTests: {TestCase selector: #a}. + self + deny: (suite tests + anySatisfy: [:test | test tests anySatisfy: [:t | t selector == #a]]); + assert: (suite tests + anySatisfy: [:test | test tests anySatisfy: [:t | t selector == #b]]); + assert: (suite tests + anySatisfy: [:test | test tests anySatisfy: [:t | t selector == #c]]). + suite removeTests: {TestSuite named: 'inner'. TestCase selector: #c}. + self assert: suite tests isEmpty +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testResult + | case result | + case := self class selector: #noop. + result := case run. + self + assert: result runCount = 1; + assert: result passedCount = 1; + assert: result failureCount = 0; + assert: result errorCount = 0 +! ! + +!SUnitTest methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +testSelectors + TestCase allSubclasses + do: [:class | self deny: (class allTestSelectors includes: #tests)] +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testShould + self should: [true]; shouldnt: [false] +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testSkip + | case result | + case := self class selector: #skip. + result := case run. + self + assert: result runCount = 0; + assert: result passedCount = 0; + assert: result failureCount = 0; + assert: result errorCount = 0; + assert: result skippedCount = 1 +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testSuite + | noop fail error suite result | + noop := self class selector: #noop. + fail := self class selector: #fail. + error := self class selector: #error. + suite := TestSuite new. + suite + addTest: noop; + addTest: fail; + addTest: error. + result := suite run. + self + assert: result runCount = 3; + assert: result passedCount = 1; + assert: result failureCount = 1; + assert: result errorCount = 1; + assert: noop time >= 0; + assert: error time >= 0; + assert: fail time >= 0 +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testTestRandomGenerator + | seed case | + case := self class selector: #testRandomGenerator. + seed := case random seed. + case run. + case setUp. + self + assert: case random seed == seed + description: 'Initial seed not restored in RandomGenerator' +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testTime + "(Delay forSeconds: 1) wait. + self assert: self time >= 1000" +! ! + +!SUnitTest methodsFor: 'all' stamp: 'KenD 28/Jun/2026 13:27:37'! +testTotalChecks + | suite result test total | + suite := TestSuite new. + suite addTest: (self class selector: #testCounter). + result := suite run. + test := result passed anyone. + total := test totalChecks. + result := suite run. + test := result passed anyone. + self assert: total = test totalChecks +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SUnitTest class' category: #'SUnit.Tests'! +SUnitTest class + instanceVariableNames: ''! + +!SUnitTest class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +shouldInheritSelectors + ^false +! ! + + diff --git a/modules/SUnit/Tests/SimpleTestResource.Class.st b/modules/SUnit/Tests/SimpleTestResource.Class.st new file mode 100644 index 00000000..4217dd00 --- /dev/null +++ b/modules/SUnit/Tests/SimpleTestResource.Class.st @@ -0,0 +1,71 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #SimpleTestResource category: #'SUnit.Tests'! +TestResource subclass: #SimpleTestResource + instanceVariableNames: 'runningState hasRun hasSetup hasRanOnce' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit.Tests'! +!SimpleTestResource commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!SimpleTestResource methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasRun + ^hasRun +! ! + +!SimpleTestResource methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasSetup + ^hasSetup +! ! + +!SimpleTestResource methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +isAvailable + ^self runningState == self startedStateSymbol! ! + +!SimpleTestResource methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +runningState + ^runningState +! ! + +!SimpleTestResource methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +runningState: aSymbol + runningState := aSymbol +! ! + +!SimpleTestResource methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +setRun + hasRun := true +! ! + +!SimpleTestResource methodsFor: 'set up' stamp: 'KenD 28/Jun/2026 13:27:37'! +setUp + self runningState: self startedStateSymbol. + hasSetup := true +! ! + +!SimpleTestResource methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +startedStateSymbol + ^#started +! ! + +!SimpleTestResource methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +stoppedStateSymbol + ^#stopped +! ! + +!SimpleTestResource methodsFor: 'finalization' stamp: 'KenD 28/Jun/2026 13:27:37'! +tearDown + self runningState: self stoppedStateSymbol +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SimpleTestResource class' category: #'SUnit.Tests'! +SimpleTestResource class + instanceVariableNames: ''! + + diff --git a/modules/SUnit/Tests/SimpleTestResourceTestCase.Class.st b/modules/SUnit/Tests/SimpleTestResourceTestCase.Class.st new file mode 100644 index 00000000..e3c3e716 --- /dev/null +++ b/modules/SUnit/Tests/SimpleTestResourceTestCase.Class.st @@ -0,0 +1,79 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #SimpleTestResourceTestCase category: #'SUnit.Tests'! +TestCase subclass: #SimpleTestResourceTestCase + instanceVariableNames: 'resource' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit.Tests'! +!SimpleTestResourceTestCase commentStamp: '' prior: 0! + + Copyright (c) 2021 Aucerna. + See (MIT) license in root directory. +! + +!SimpleTestResourceTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +dummy + self assert: true +! ! + +!SimpleTestResourceTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +error + 'foo' odd +! ! + +!SimpleTestResourceTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +fail + self assert: false +! ! + +!SimpleTestResourceTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +setRun + resource setRun +! ! + +!SimpleTestResourceTestCase methodsFor: 'set up' stamp: 'KenD 28/Jun/2026 13:27:37'! +setUp + resource := SimpleTestResource current +! ! + +!SimpleTestResourceTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +testRan + | case | + + case := self class selector: #setRun. + case run. + self assert: resource hasSetup. + self assert: resource hasRun +! ! + +!SimpleTestResourceTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +testResourceInitRelease + | result suite error failure | + suite := TestSuite new. + suite addTest: (error := self class selector: #error). + suite addTest: (failure := self class selector: #fail). + suite addTest: (self class selector: #dummy). + result := suite run. + self assert: resource hasSetup +! ! + +!SimpleTestResourceTestCase methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +testResourcesCollection + | collection | + collection := self resources. + self assert: collection size = 1 +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'SimpleTestResourceTestCase class' category: #'SUnit.Tests'! +SimpleTestResourceTestCase class + instanceVariableNames: ''! + +!SimpleTestResourceTestCase class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:37'! +resources + ^Set new add: SimpleTestResource; yourself +! ! + + diff --git a/modules/SUnit/Tests/TestsModule.Class.st b/modules/SUnit/Tests/TestsModule.Class.st new file mode 100644 index 00000000..40908a87 --- /dev/null +++ b/modules/SUnit/Tests/TestsModule.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestsModule category: #Test! +Module subclass: #TestsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Test'! +!TestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(Error). + #SUnit -> #(SUnitNameResolver TestCase TestResource TestResult TestSuite) + } +! ! + +!TestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + super initialize +! ! + +!TestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +main: args + | result | + Kernel log: 'running tests...', String cr. + + result := SUnitTest buildTestSuite run. + Kernel log: 'done', String cr. + Kernel log: 'Results: ', String cr. + Kernel log: result printString, String cr, String cr. +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestsModule class' category: #Test! +TestsModule class + instanceVariableNames: ''! + + +TestsModule initialize! + diff --git a/modules/TOML/TOMLModule.Class.st b/modules/TOML/TOMLModule.Class.st new file mode 100644 index 00000000..1e3d1c91 --- /dev/null +++ b/modules/TOML/TOMLModule.Class.st @@ -0,0 +1,28 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TOMLModule category: #TOML! +Module subclass: #TOMLModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'TOML'! +!TOMLModule commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!TOMLModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(Character Error OrderedDictionary). + } +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TOMLModule class' category: #TOML! +TOMLModule class + instanceVariableNames: ''! + + diff --git a/modules/TOML/TOMLParser.Class.st b/modules/TOML/TOMLParser.Class.st new file mode 100644 index 00000000..55b054d0 --- /dev/null +++ b/modules/TOML/TOMLParser.Class.st @@ -0,0 +1,663 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TOMLParser category: #TOML! +Object subclass: #TOMLParser + instanceVariableNames: 'stream root current' + classVariableNames: '' + poolDictionaries: '' + category: 'TOML'! +!TOMLParser commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!TOMLParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +atTripleQuote: aCharacter + | position | + stream peek = aCharacter ifFalse: [^false]. + position := stream position. + stream next. + (stream peekFor: aCharacter) ifTrue: [ + (stream peekFor: aCharacter) ifTrue: [^true]]. + stream position: position. + ^false +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +error: aString + ^Error signal: 'TOML parse error at position ', + stream position asString, ': ', aString +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +expect: aString + aString do: [:each | + (stream peekFor: each) ifFalse: [ + self error: 'Expected "', aString, '"']] +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +expectChar: aCharacter + | found | + (stream peekFor: aCharacter) ifTrue: [^self]. + found := stream atEnd + ifTrue: ['end of input'] + ifFalse: [stream peek asString]. + self error: 'Expected ', aCharacter asString, ' but got ', found +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +hexValue: aCharacter + | code | + code := aCharacter asInteger. + (code between: 48 and: 57) ifTrue: [^code - 48]. + (code between: 65 and: 70) ifTrue: [^code - 55]. + (code between: 97 and: 102) ifTrue: [^code - 87]. + self error: 'Invalid hex digit' +! ! + +!TOMLParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isBareKeyChar: aCharacter + ^aCharacter isAlphanumeric or: [aCharacter = $- or: [aCharacter = $_]] +! ! + +!TOMLParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isBinaryChar: aCharacter + ^aCharacter = $0 or: [aCharacter = $1 or: [aCharacter = $_]] +! ! + +!TOMLParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isHexChar: aCharacter + ^aCharacter isDigit or: [ + (aCharacter between: $a and: $f) or: [ + (aCharacter between: $A and: $F) or: [aCharacter = $_]]] +! ! + +!TOMLParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isNewline: aCharacter + ^aCharacter = Character cr or: [aCharacter = Character lf] +! ! + +!TOMLParser methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isOctalChar: aCharacter + ^(aCharacter between: $0 and: $7) or: [aCharacter = $_] +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +matchChar: aCharacter + ^stream peekFor: aCharacter +! ! + +!TOMLParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +on: aReadStream + stream := aReadStream +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parse + root := OrderedDictionary new. + current := root. + [stream atEnd] whileFalse: [self parseLine]. + ^root +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseArray + | elements | + self expectChar: $[. + elements := OrderedCollection new. + self skipWhitespaceAndNewlines. + (self matchChar: $]) ifTrue: [^elements asArray]. + [ + self skipWhitespaceAndNewlines. + elements add: self parseValue. + self skipWhitespaceAndNewlines. + self matchChar: $,] whileTrue: [ + self skipWhitespaceAndNewlines. + (stream peek = $]) ifTrue: [ + self expectChar: $]. + ^elements asArray]]. + self skipWhitespaceAndNewlines. + self expectChar: $]. + ^elements asArray +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseArrayTable + | key table array | + self skipWhitespace. + key := self parseDottedKey. + self + skipWhitespace; + expectChar: $]; + expectChar: $]; + skipToNewline. + table := self resolveTable: key allButLast create: true. + array := table at: key last ifAbsent: [nil]. + array ifNil: [ + array := OrderedCollection new. + table at: key last put: array]. + current := OrderedDictionary new. + array add: current +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseBareKey + | start | + start := stream position. + [stream atEnd not and: [self isBareKeyChar: stream peek]] + whileTrue: [stream next]. + stream position = start ifTrue: [self error: 'Empty bare key']. + ^stream collection copyFrom: start + 1 to: stream position +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseBasicString + self expectChar: $". + ^self parseBasicStringBody +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseBasicStringBody + | result | + result := String streamContents: [:s | + [stream atEnd or: [stream peek = $"]] + whileFalse: [s nextPut: self parseCharacter]]. + self expectChar: $". + ^result +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseBinaryInteger: aBoolean + | value count | + value := 0. + count := 0. + [stream atEnd not and: [self isBinaryChar: stream peek]] + whileTrue: [ + | digit | + digit := stream next. + digit = $_ ifFalse: [ + value := value * 2 + digit digitValue. + count := count + 1]]. + count = 0 ifTrue: [self error: 'Expected binary digit']. + aBoolean ifTrue: [^value negated]. + ^value +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseCharacter + | char | + char := stream next. + char = $\ ifTrue: [^self parseEscape]. + ^char +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseDecimalNumber: aBoolean + | integer | + integer := self parseDigits. + (stream atEnd not and: [stream peek = $.]) ifTrue: [ + stream next. + ^self parseFloat: integer negated: aBoolean]. + (stream atEnd not and: [stream peek = $e or: [stream peek = $E]]) ifTrue: [ + stream next. + ^self parseExponent: integer asFloat negated: aBoolean]. + aBoolean ifTrue: [^integer negated]. + ^integer +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseDigits + | value count | + value := 0. + count := 0. + [stream atEnd not and: [stream peek isDigit or: [stream peek = $_]]] + whileTrue: [ + | digit | + digit := stream next. + digit = $_ ifFalse: [ + value := value * 10 + digit digitValue. + count := count + 1]]. + count = 0 ifTrue: [self error: 'Expected digit']. + ^value +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseDottedKey + | parts | + parts := OrderedCollection new. + parts add: self parseKey. + [self skipWhitespace. stream peekFor: $.] whileTrue: [ + self skipWhitespace. + parts add: self parseKey]. + ^parts asArray +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseEscape + | char | + char := stream next. + char = $b ifTrue: [^Character backspace]. + char = $t ifTrue: [^Character tab]. + char = $n ifTrue: [^Character lf]. + char = $f ifTrue: [^Character newPage]. + char = $r ifTrue: [^Character cr]. + char = $" ifTrue: [^$"]. + char = $\ ifTrue: [^$\]. + char = $u ifTrue: [^self parseUnicode: 4]. + char = $U ifTrue: [^self parseUnicode: 8]. + self error: 'Invalid escape: \', char asString +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseExponent: aNumber negated: aBoolean + | negative exponent result | + negative := stream peekFor: $-. + negative ifFalse: [stream peekFor: $+]. + exponent := self parseDigits. + negative ifTrue: [exponent := exponent negated]. + result := aNumber * (10 raisedTo: exponent). + aBoolean ifTrue: [^result negated]. + ^result +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseFalse + self expect: 'false'. + ^false +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseFloat: anInteger negated: aBoolean + | fraction power result | + fraction := 0. + power := 1.0. + [stream atEnd not and: [stream peek isDigit or: [stream peek = $_]]] + whileTrue: [ + | digit | + digit := stream next. + digit = $_ ifFalse: [ + fraction := fraction * 10 + digit digitValue. + power := power * 10.0]]. + result := anInteger + (fraction / power). + (stream atEnd not and: [stream peek = $e or: [stream peek = $E]]) ifTrue: [ + stream next. + ^self parseExponent: result negated: aBoolean]. + aBoolean ifTrue: [^result negated]. + ^result +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseHexDigit + | char code | + stream atEnd ifTrue: [self error: 'Expected hex digit']. + char := stream next. + code := char asInteger. + (code between: 48 and: 57) ifTrue: [^code - 48]. + (code between: 65 and: 70) ifTrue: [^code - 55]. + (code between: 97 and: 102) ifTrue: [^code - 87]. + self error: 'Invalid hex digit: ', char asString +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseHexInteger: aBoolean + | value count | + value := 0. + count := 0. + [stream atEnd not and: [self isHexChar: stream peek]] + whileTrue: [ | digit | + digit := stream next. + digit = $_ ifFalse: [ + value := (value bitShift: 4) + (self hexValue: digit). + count := count + 1]]. + count = 0 ifTrue: [self error: 'Expected hex digit']. + aBoolean ifTrue: [^value negated]. + ^value +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseInlineTable + | table | + self expectChar: ${. + table := OrderedDictionary new. + self skipWhitespace. + (self matchChar: $}) ifTrue: [^table]. + [ + self skipWhitespace. + self parseKeyValueInto: table. + self skipWhitespace. + self matchChar: $,] whileTrue. + self skipWhitespace. + self expectChar: $}. + ^table +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseKey + | char | + stream atEnd ifTrue: [self error: 'Expected key']. + char := stream peek. + char = $" ifTrue: [^self parseBasicString]. + char = $' ifTrue: [^self parseLiteralString]. + ^self parseBareKey +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseKeyValue + | key value target last | + key := self parseDottedKey. + self + skipWhitespace; + expectChar: $=; + skipWhitespace. + value := self parseValue. + self skipToNewline. + target := self resolveIn: current path: key allButLast create: true. + last := key last. + (target includesKey: last) + ifTrue: [self error: 'Duplicate key: ', last]. + target at: last put: value +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseKeyValueInto: aDictionary + | key value target | + key := self parseDottedKey. + self + skipWhitespace; + expectChar: $=; + skipWhitespace. + value := self parseValue. + target := self resolveIn: aDictionary path: key allButLast create: true. + target at: key last put: value +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseLine + | char | + self skipWhitespace. + stream atEnd ifTrue: [^self]. + char := stream peek. + char = $# ifTrue: [^self skipComment]. + char = $[ ifTrue: [^self parseTableHeader]. + (char = Character cr or: [char = Character lf]) + ifTrue: [^self skipNewline]. + self parseKeyValue +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseLiteralString + self expectChar: $'. + ^self parseLiteralStringBody +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseLiteralStringBody + | result | + result := String streamContents: [:s | + [stream atEnd or: [stream peek = $']] + whileFalse: [s nextPut: stream next]]. + self expectChar: $'. + ^result +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseLiteralStringValue + stream next. + (stream peekFor: $') + ifTrue: [ + (stream peekFor: $') + ifTrue: [^self parseMultilineLiteralString] + ifFalse: [^'']] + ifFalse: [^self parseLiteralStringBody] +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseMultilineBasicChar: aStream + | char | + char := stream next. + char = $\ ifFalse: [^aStream nextPut: char]. + (self isNewline: stream peek) + ifTrue: [self skipWhitespaceAndNewlines] + ifFalse: [stream back. aStream nextPut: self parseCharacter] +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseMultilineBasicString + self skipNewlineIfPresent. + ^String streamContents: [:s | + [stream atEnd or: [self atTripleQuote: $"]] + whileFalse: [self parseMultilineBasicChar: s]] +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseMultilineLiteralString + self skipNewlineIfPresent. + ^String streamContents: [:s | + [stream atEnd or: [self atTripleQuote: $']] + whileFalse: [s nextPut: stream next]] +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseNumberValue + | start negated sign | + negated := false. + sign := stream peek. + (sign = $+ or: [sign = $-]) ifTrue: [ + negated := sign = $-. + stream next]. + start := stream position. + stream peek = $0 ifTrue: [ + ^self parsePrefixedNumber: negated from: start]. + ^self parseDecimalNumber: negated +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseOctalInteger: aBoolean + | value count | + value := 0. + count := 0. + [stream atEnd not and: [self isOctalChar: stream peek]] + whileTrue: [ + | digit | + digit := stream next. + digit = $_ ifFalse: [ + value := value * 8 + digit digitValue. + count := count + 1]]. + count = 0 ifTrue: [self error: 'Expected octal digit']. + aBoolean ifTrue: [^value negated]. + ^value +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parsePrefixedNumber: aBoolean from: anInteger + | prefix | + stream next. + stream atEnd ifTrue: [^0]. + prefix := stream peek. + prefix = $x ifTrue: [stream next. ^self parseHexInteger: aBoolean]. + prefix = $o ifTrue: [stream next. ^self parseOctalInteger: aBoolean]. + prefix = $b ifTrue: [stream next. ^self parseBinaryInteger: aBoolean]. + (prefix = $. or: [prefix = $e or: [prefix = $E]]) + ifTrue: [stream position: anInteger. ^self parseDecimalNumber: aBoolean]. + ^0 +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseSpecialFloat + | position | + position := stream position. + (self tryMatch: 'inf') ifTrue: [^Float infinity]. + (self tryMatch: 'nan') ifTrue: [^Float nan]. + stream position: position. + self error: 'Unexpected character' +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseStringValue + stream next. + (stream peekFor: $") + ifTrue: [ + (stream peekFor: $") + ifTrue: [^self parseMultilineBasicString] + ifFalse: [^'']] + ifFalse: [^self parseBasicStringBody] +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseTable + | key | + self skipWhitespace. + key := self parseDottedKey. + self + skipWhitespace; + expectChar: $]; + skipToNewline. + current := self resolveTable: key create: true +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseTableHeader + stream next. + (stream peekFor: $[) + ifTrue: [self parseArrayTable] + ifFalse: [self parseTable] +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseTrue + self expect: 'true'. + ^true +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseUnicode: anInteger + | value | + value := 0. + anInteger timesRepeat: [ + value := (value bitShift: 4) + self parseHexDigit]. + ^Character codePoint: value +! ! + +!TOMLParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseValue + | char | + stream atEnd ifTrue: [self error: 'Expected value']. + char := stream peek. + char = $" ifTrue: [^self parseStringValue]. + char = $' ifTrue: [^self parseLiteralStringValue]. + char = $t ifTrue: [^self parseTrue]. + char = $f ifTrue: [^self parseFalse]. + char = $[ ifTrue: [^self parseArray]. + char = ${ ifTrue: [^self parseInlineTable]. + (char = $- or: [char = $+ or: [char isDigit]]) + ifTrue: [^self parseNumberValue]. + char = $i ifTrue: [^self parseSpecialFloat]. + char = $n ifTrue: [^self parseSpecialFloat]. + self error: 'Unexpected character: ', char asString +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +resolveIn: aDictionary path: anArray create: aBoolean + | table | + table := aDictionary. + anArray do: [:key | + | next | + next := table at: key ifAbsent: [nil]. + next ifNil: [ + aBoolean ifFalse: [^nil]. + next := OrderedDictionary new. + table at: key put: next]. + (next isKindOf: OrderedCollection) + ifTrue: [table := next last] + ifFalse: [table := next]]. + ^table +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +resolveTable: anArray create: aBoolean + ^self resolveIn: root path: anArray create: aBoolean +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipComment + [stream atEnd not and: [(self isNewline: stream peek) not]] + whileTrue: [stream next] +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipNewline + (stream peekFor: Character cr) ifTrue: [stream peekFor: Character lf]. + stream peekFor: Character lf +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipNewlineIfPresent + (stream atEnd not and: [self isNewline: stream peek]) + ifTrue: [self skipNewline] +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipToNewline + self skipWhitespace. + stream atEnd ifTrue: [^self]. + stream peek = $# ifTrue: [self skipComment]. + stream atEnd ifTrue: [^self]. + (self isNewline: stream peek) + ifTrue: [self skipNewline] + ifFalse: [self error: 'Expected newline, got: ', stream peek asString] +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipWhitespace + [stream atEnd not and: [ + | char | + char := stream peek. + char = Character space or: [char = Character tab]]] + whileTrue: [stream next] +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +skipWhitespaceAndNewlines + [stream atEnd not and: [ + | char | + char := stream peek. + char = Character space or: [ + char = Character tab or: [ + char = Character cr or: [ + char = Character lf or: [char = $#]]]]]] + whileTrue: [ + stream peek = $# + ifTrue: [self skipComment] + ifFalse: [stream next]] +! ! + +!TOMLParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +tryMatch: aString + | position | + position := stream position. + aString do: [:each | + (stream peekFor: each) ifFalse: [ + stream position: position. + ^false]]. + ^true +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TOMLParser class' category: #TOML! +TOMLParser class + instanceVariableNames: ''! + +!TOMLParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +on: aReadStream + ^self new on: aReadStream +! ! + +!TOMLParser class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +parse: aString + ^(self on: aString readStream) parse +! ! + + diff --git a/modules/TOML/TOMLWriter.Class.st b/modules/TOML/TOMLWriter.Class.st new file mode 100644 index 00000000..33f6bf4c --- /dev/null +++ b/modules/TOML/TOMLWriter.Class.st @@ -0,0 +1,185 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TOMLWriter category: #TOML! +Object subclass: #TOMLWriter + instanceVariableNames: 'stream indent' + classVariableNames: '' + poolDictionaries: '' + category: 'TOML'! +!TOMLWriter commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!TOMLWriter methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isArrayOfTables: anObject + (anObject isKindOf: Array) ifFalse: [ + (anObject isKindOf: OrderedCollection) ifFalse: [^false]]. + anObject isEmpty ifTrue: [^false]. + ^anObject first isKindOf: OrderedDictionary +! ! + +!TOMLWriter methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isBareKey: aString + aString isEmpty ifTrue: [^false]. + ^aString allSatisfy: [:ch | + ch isAlphanumeric or: [ch = $- or: [ch = $_]]] +! ! + +!TOMLWriter methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +isTable: anObject + ^(anObject isKindOf: OrderedDictionary) + or: [self isArrayOfTables: anObject] +! ! + +!TOMLWriter methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +on: aWriteStream + stream := aWriteStream. + indent := '' +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeArray: anArray + stream nextPut: $[. + anArray withIndexDo: [:elem :i | + i > 1 ifTrue: [stream nextPutAll: ', ']. + self writeValue: elem]. + stream nextPut: $] +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeArrayOfTables: anArray path: aPath + anArray do: [:table | + stream nextPutAll: '[['. + self writePath: aPath. + stream nextPutAll: ']]'. + stream nextPut: Character lf. + self writeTopLevel: table path: aPath] +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +write: aDictionary + self writeTopLevel: aDictionary path: #() +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeBasicString: aString + stream nextPut: $". + aString do: [:ch | + ch = $" ifTrue: [stream nextPut: $\]. + ch = $\ ifTrue: [stream nextPut: $\]. + ch = Character lf ifTrue: [stream nextPutAll: '\n'. ^self]. + ch = Character cr ifTrue: [stream nextPutAll: '\r'. ^self]. + ch = Character tab ifTrue: [stream nextPutAll: '\t'. ^self]. + stream nextPut: ch]. + stream nextPut: $" +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeFloat: aFloat + aFloat isInfinite + ifTrue: [ + aFloat > 0 + ifTrue: [stream nextPutAll: 'inf'] + ifFalse: [stream nextPutAll: '-inf']] + ifFalse: [ + aFloat isNaN + ifTrue: [stream nextPutAll: 'nan'] + ifFalse: [stream nextPutAll: aFloat printString]] +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeInlineTable: aDictionary + | first | + stream nextPutAll: '{'. + first := true. + aDictionary keysAndValuesDo: [:k :v | + first ifTrue: [first := false] ifFalse: [stream nextPutAll: ', ']. + self writeKeyName: k. + stream nextPutAll: ' = '. + self writeValue: v]. + stream nextPutAll: '}' +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeKey: aString value: anObject + self writeKeyName: aString. + stream nextPutAll: ' = '. + self writeValue: anObject. + stream nextPut: Character lf +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeKeyName: aString + (self isBareKey: aString) + ifTrue: [stream nextPutAll: aString] + ifFalse: [self writeBasicString: aString] +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writePath: anArray + anArray withIndexDo: [:key :i | + i > 1 ifTrue: [stream nextPut: $.]. + self writeKeyName: key] +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeTableHeader: anArray + stream nextPut: $[. + self writePath: anArray. + stream nextPut: $]. + stream nextPut: Character lf +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeTopLevel: aDictionary path: anArray + | tables | + tables := OrderedCollection new. + aDictionary keysAndValuesDo: [:k :v | + (self isTable: v) + ifTrue: [tables add: k -> v] + ifFalse: [self writeKey: k value: v]]. + tables do: [:assoc | + | key value path | + key := assoc key. + value := assoc value. + path := anArray copyWith: key. + (self isArrayOfTables: value) + ifTrue: [self writeArrayOfTables: value path: path] + ifFalse: [self writeTableHeader: path. + self writeTopLevel: value path: path]] +! ! + +!TOMLWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:37'! +writeValue: anObject + anObject isString ifTrue: [^self writeBasicString: anObject]. + anObject = true ifTrue: [^stream nextPutAll: 'true']. + anObject = false ifTrue: [^stream nextPutAll: 'false']. + anObject isInteger ifTrue: [^stream nextPutAll: anObject printString]. + anObject isFloat ifTrue: [^self writeFloat: anObject]. + (anObject isKindOf: Array) ifTrue: [^self writeArray: anObject]. + (anObject isKindOf: OrderedCollection) + ifTrue: [^self writeArray: anObject asArray]. + (anObject isKindOf: OrderedDictionary) ifTrue: [^self writeInlineTable: anObject]. + stream nextPutAll: anObject printString +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TOMLWriter class' category: #TOML! +TOMLWriter class + instanceVariableNames: ''! + +!TOMLWriter class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +on: aWriteStream + ^self new on: aWriteStream +! ! + +!TOMLWriter class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:37'! +write: aDictionary + ^String streamContents: [:s | + (self on: s) write: aDictionary] +! ! + + diff --git a/modules/TOML/Tests/TOMLParserTest.Class.st b/modules/TOML/Tests/TOMLParserTest.Class.st new file mode 100644 index 00000000..6e4e4a92 --- /dev/null +++ b/modules/TOML/Tests/TOMLParserTest.Class.st @@ -0,0 +1,360 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TOMLParserTest category: #'TOML.Tests'! +TestCase subclass: #TOMLParserTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'TOML.Tests'! +!TOMLParserTest commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!TOMLParserTest methodsFor: 'testing - strings' stamp: 'KenD 28/Jun/2026 13:27:37'! +testBasicString + | result | + result := TOMLParser parse: 'key = "hello"'. + self assert: (result at: 'key') equals: 'hello' +! ! + +!TOMLParserTest methodsFor: 'testing - strings' stamp: 'KenD 28/Jun/2026 13:27:37'! +testStringEscapes + | result | + result := TOMLParser parse: 'key = "hello\nworld"'. + self assert: (result at: 'key') equals: 'hello', Character lf asString, 'world' +! ! + +!TOMLParserTest methodsFor: 'testing - strings' stamp: 'KenD 28/Jun/2026 13:27:37'! +testEmptyString + | result | + result := TOMLParser parse: 'key = ""'. + self assert: (result at: 'key') equals: '' +! ! + +!TOMLParserTest methodsFor: 'testing - strings' stamp: 'KenD 28/Jun/2026 13:27:37'! +testLiteralString + | result | + result := TOMLParser parse: 'key = ''no \escapes'''. + self assert: (result at: 'key') equals: 'no \escapes' +! ! + +!TOMLParserTest methodsFor: 'testing - strings' stamp: 'KenD 28/Jun/2026 13:27:37'! +testMultilineBasicString + | input result | + input := 'key = """ +hello +world"""'. + result := TOMLParser parse: input. + self assert: (result at: 'key') equals: 'hello', Character lf asString, 'world' +! ! + +!TOMLParserTest methodsFor: 'testing - strings' stamp: 'KenD 28/Jun/2026 13:27:37'! +testMultilineLiteralString + | input result | + input := 'key = '''''' +first +second'''''''. + result := TOMLParser parse: input. + self assert: (result at: 'key') equals: 'first', Character lf asString, 'second' +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testInteger + | result | + result := TOMLParser parse: 'key = 42'. + self assert: (result at: 'key') equals: 42 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testNegativeInteger + | result | + result := TOMLParser parse: 'key = -17'. + self assert: (result at: 'key') equals: -17 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testPositiveInteger + | result | + result := TOMLParser parse: 'key = +99'. + self assert: (result at: 'key') equals: 99 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testZero + | result | + result := TOMLParser parse: 'key = 0'. + self assert: (result at: 'key') equals: 0 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testUnderscoresInInteger + | result | + result := TOMLParser parse: 'key = 1_000_000'. + self assert: (result at: 'key') equals: 1000000 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testHexInteger + | result | + result := TOMLParser parse: 'key = 0xff'. + self assert: (result at: 'key') equals: 255 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testOctalInteger + | result | + result := TOMLParser parse: 'key = 0o77'. + self assert: (result at: 'key') equals: 63 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testBinaryInteger + | result | + result := TOMLParser parse: 'key = 0b1010'. + self assert: (result at: 'key') equals: 10 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testFloat + | result | + result := TOMLParser parse: 'key = 3.14'. + self assert: ((result at: 'key') - 3.14) abs < 0.001 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testFloatWithExponent + | result | + result := TOMLParser parse: 'key = 1e10'. + self assert: (result at: 'key') equals: 10000000000.0 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testNegativeFloat + | result | + result := TOMLParser parse: 'key = -0.5'. + self assert: ((result at: 'key') + 0.5) abs < 0.001 +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testInfinity + | result | + result := TOMLParser parse: 'key = inf'. + self assert: (result at: 'key') equals: Float infinity +! ! + +!TOMLParserTest methodsFor: 'testing - numbers' stamp: 'KenD 28/Jun/2026 13:27:37'! +testNan + | result | + result := TOMLParser parse: 'key = nan'. + self assert: (result at: 'key') isNaN +! ! + +!TOMLParserTest methodsFor: 'testing - booleans' stamp: 'KenD 28/Jun/2026 13:27:37'! +testTrue + | result | + result := TOMLParser parse: 'key = true'. + self assert: (result at: 'key') equals: true +! ! + +!TOMLParserTest methodsFor: 'testing - booleans' stamp: 'KenD 28/Jun/2026 13:27:37'! +testFalse + | result | + result := TOMLParser parse: 'key = false'. + self assert: (result at: 'key') equals: false +! ! + +!TOMLParserTest methodsFor: 'testing - arrays' stamp: 'KenD 28/Jun/2026 13:27:37'! +testEmptyArray + | result | + result := TOMLParser parse: 'key = []'. + self assert: (result at: 'key') equals: #() +! ! + +!TOMLParserTest methodsFor: 'testing - arrays' stamp: 'KenD 28/Jun/2026 13:27:37'! +testIntegerArray + | result | + result := TOMLParser parse: 'key = [1, 2, 3]'. + self assert: (result at: 'key') equals: #(1 2 3) +! ! + +!TOMLParserTest methodsFor: 'testing - arrays' stamp: 'KenD 28/Jun/2026 13:27:37'! +testMixedArray + | result array | + result := TOMLParser parse: 'key = [1, "two", true]'. + array := result at: 'key'. + self + assert: array size equals: 3; + assert: (array at: 1) equals: 1; + assert: (array at: 2) equals: 'two'; + assert: (array at: 3) equals: true +! ! + +!TOMLParserTest methodsFor: 'testing - arrays' stamp: 'KenD 28/Jun/2026 13:27:37'! +testMultilineArray + | input result | + input := 'key = [ + 1, + 2, + 3, +]'. + result := TOMLParser parse: input. + self assert: (result at: 'key') equals: #(1 2 3) +! ! + +!TOMLParserTest methodsFor: 'testing - tables' stamp: 'KenD 28/Jun/2026 13:27:37'! +testSimpleTable + | input result | + input := '[server] +host = "localhost" +port = 8080'. + result := TOMLParser parse: input. + self + assert: ((result at: 'server') at: 'host') equals: 'localhost'; + assert: ((result at: 'server') at: 'port') equals: 8080 +! ! + +!TOMLParserTest methodsFor: 'testing - tables' stamp: 'KenD 28/Jun/2026 13:27:37'! +testNestedTable + | input result | + input := '[a.b] +key = "value"'. + result := TOMLParser parse: input. + self assert: (((result at: 'a') at: 'b') at: 'key') equals: 'value' +! ! + +!TOMLParserTest methodsFor: 'testing - tables' stamp: 'KenD 28/Jun/2026 13:27:37'! +testInlineTable + | result table | + result := TOMLParser parse: 'point = {x = 1, y = 2}'. + table := result at: 'point'. + self + assert: (table at: 'x') equals: 1; + assert: (table at: 'y') equals: 2 +! ! + +!TOMLParserTest methodsFor: 'testing - tables' stamp: 'KenD 28/Jun/2026 13:27:37'! +testArrayOfTables + | input result products | + input := '[[products]] +name = "Hammer" + +[[products]] +name = "Nail"'. + result := TOMLParser parse: input. + products := result at: 'products'. + self + assert: products size equals: 2; + assert: (products first at: 'name') equals: 'Hammer'; + assert: (products last at: 'name') equals: 'Nail' +! ! + +!TOMLParserTest methodsFor: 'testing - keys' stamp: 'KenD 28/Jun/2026 13:27:37'! +testBareKey + | result | + result := TOMLParser parse: 'bare-key_123 = "value"'. + self assert: (result at: 'bare-key_123') equals: 'value' +! ! + +!TOMLParserTest methodsFor: 'testing - keys' stamp: 'KenD 28/Jun/2026 13:27:37'! +testQuotedKey + | result | + result := TOMLParser parse: '"quoted key" = "value"'. + self assert: (result at: 'quoted key') equals: 'value' +! ! + +!TOMLParserTest methodsFor: 'testing - keys' stamp: 'KenD 28/Jun/2026 13:27:37'! +testDottedKey + | result | + result := TOMLParser parse: 'a.b.c = "deep"'. + self assert: (((result at: 'a') at: 'b') at: 'c') equals: 'deep' +! ! + +!TOMLParserTest methodsFor: 'testing - comments' stamp: 'KenD 28/Jun/2026 13:27:37'! +testComment + | input result | + input := '# this is a comment +key = "value" # inline comment'. + result := TOMLParser parse: input. + self assert: (result at: 'key') equals: 'value' +! ! + +!TOMLParserTest methodsFor: 'testing - keys' stamp: 'KenD 28/Jun/2026 13:27:37'! +testMultipleKeyValues + | input result | + input := 'name = "test" +version = "1.0" +count = 5'. + result := TOMLParser parse: input. + self + assert: (result at: 'name') equals: 'test'; + assert: (result at: 'version') equals: '1.0'; + assert: (result at: 'count') equals: 5 +! ! + +!TOMLParserTest methodsFor: 'testing - errors' stamp: 'KenD 28/Jun/2026 13:27:37'! +testDuplicateKeyError + self should: [ + TOMLParser parse: 'key = 1 +key = 2'] raise: Error +! ! + +!TOMLParserTest methodsFor: 'testing - integration' stamp: 'KenD 28/Jun/2026 13:27:37'! +testEpmToml + | input result project dependencies | + input := '[project] +name = "myapp" +version = "0.1.0" +description = "A test app" + +[dependencies] +JSON = ">=1.0" +STON = "~>2.0"'. + result := TOMLParser parse: input. + project := result at: 'project'. + dependencies := result at: 'dependencies'. + self + assert: (project at: 'name') equals: 'myapp'; + assert: (project at: 'version') equals: '0.1.0'; + assert: (dependencies at: 'JSON') equals: '>=1.0'; + assert: (dependencies at: 'STON') equals: '~>2.0' +! ! + +!TOMLParserTest methodsFor: 'testing - integration' stamp: 'KenD 28/Jun/2026 13:27:37'! +testComplexDocument + | input result owner database servers | + input := 'title = "TOML Example" + +[owner] +name = "John" + +[database] +ports = [8001, 8001, 8002] +enabled = true + +[servers.alpha] +ip = "10.0.0.1" + +[servers.beta] +ip = "10.0.0.2"'. + result := TOMLParser parse: input. + owner := result at: 'owner'. + database := result at: 'database'. + servers := result at: 'servers'. + self + assert: (result at: 'title') equals: 'TOML Example'; + assert: (owner at: 'name') equals: 'John'; + assert: (database at: 'ports') equals: #(8001 8001 8002); + assert: (database at: 'enabled') equals: true; + assert: ((servers at: 'alpha') at: 'ip') equals: '10.0.0.1'; + assert: ((servers at: 'beta') at: 'ip') equals: '10.0.0.2' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TOMLParserTest class' category: #'TOML.Tests'! +TOMLParserTest class + instanceVariableNames: ''! + + diff --git a/modules/TOML/Tests/TestsModule.Class.st b/modules/TOML/Tests/TestsModule.Class.st new file mode 100644 index 00000000..8de60384 --- /dev/null +++ b/modules/TOML/Tests/TestsModule.Class.st @@ -0,0 +1,46 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TestsModule category: #'TOML.Tests'! +Module subclass: #TestsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'TOML.Tests'! +!TestsModule commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!TestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(Error OrderedDictionary). + #TOML -> #(TOMLParser). + #SUnit -> #(TestCase TestResult) + } +! ! + +!TestsModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:37'! +main: anArray + | suite result | + Kernel log: 'Running TOML tests... +'. + suite := TOMLParserTest buildTestSuite. + Kernel log: 'suite built with ', suite tests size printString, ' tests +'. + result := suite run. + Kernel log: 'Done. +'. + Kernel log: result printString. + Kernel log: ' +' +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestsModule class' category: #'TOML.Tests'! +TestsModule class + instanceVariableNames: ''! + + diff --git a/modules/TinyBenchmarks/TinyBenchmarksModule.Class.st b/modules/TinyBenchmarks/TinyBenchmarksModule.Class.st new file mode 100644 index 00000000..61d63128 --- /dev/null +++ b/modules/TinyBenchmarks/TinyBenchmarksModule.Class.st @@ -0,0 +1,102 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:37 pm'! +!classDefinition: #TinyBenchmarksModule category: #TinyBenchmarks! +Module subclass: #TinyBenchmarksModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'TinyBenchmarks'! +!TinyBenchmarksModule commentStamp: '' prior: 0! + + Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!TinyBenchmarksModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> {#Integer. #Time} + } +! ! + +!TinyBenchmarksModule methodsFor: 'benchmarking' stamp: 'KenD 28/Jun/2026 13:27:37'! +tinyBenchmarks + " + Report the results of running the two tiny Squeak benchmarks. + ar 9/10/1999: Adjusted to run at least 1 sec to get more stable results + 0 tinyBenchmarks + On a 292 MHz G3 Mac: 22727272 bytecodes/sec; 984169 sends/sec + On a 400 MHz PII/Win98: 18028169 bytecodes/sec; 1081272 sends/sec + " + | t1 t2 r n1 n2 | + n1 := 256. + [ + t1 := Time millisecondsToRun: [self bytecodeIntensiveBenchmark: n1]. + t1 < 1000] + whileTrue: [n1 := n1 * 2]. + "Note: #benchmark's runtime is about O(n)" + + n2 := 26. + [ + t2 := Time millisecondsToRun: [r := self fibonacchi: n2]. + t2 < 1000] + whileTrue: [n2 := n2 + 1]. + + "Note: #fibonacchi's runtime is about O(n^2)." + + ^(n1 * 500000 * 1000 // t1) printString , ' bytecodes/sec; ' + , (r * 1000 // t2) printString + , ' sends/sec' +! ! + +!TinyBenchmarksModule methodsFor: 'benchmarking' stamp: 'KenD 28/Jun/2026 13:27:37'! +bytecodeIntensiveBenchmark: anInteger + " + (500000 // time to run) = approx bytecodes per second + 5000000 // (Time millisecondsToRun: [10 benchmark]) * 1000 + 3059000 on a Mac 8100/100 + " + | size flags prime k count | + size := 8190. + 1 to: anInteger do: [:iter | + count := 0. + flags := (Array new: size) atAllPut: true. + 1 to: size do: [:i | + (flags at: i) ifTrue: [ + prime := i + 1. + k := i + prime. + [k <= size] whileTrue: [ + flags at: k put: false. + k := k + prime]. + count := count + 1]]]. + ^count +! ! + +!TinyBenchmarksModule methodsFor: 'benchmarking' stamp: 'KenD 28/Jun/2026 13:27:37'! +fibonacchi: anInteger + " + Handy send-heavy benchmark + (result // seconds to run) = approx calls per second + | r t | + t := Time millisecondsToRun: [r := 26 benchFib]. + (r * 1000) // t + 138000 on a Mac 8100/100 + " + ^anInteger < 2 + ifTrue: [1] + ifFalse: [(self fibonacchi: anInteger - 1) + (self fibonacchi: anInteger - 2) + 1] +! ! + +!TinyBenchmarksModule methodsFor: 'cli' stamp: 'KenD 28/Jun/2026 13:27:37'! +main: args + + Kernel log: self tinyBenchmarks, String cr +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TinyBenchmarksModule class' category: #TinyBenchmarks! +TinyBenchmarksModule class + instanceVariableNames: ''! + + diff --git a/modules/Tonel/Loader/LoaderModule.Class.st b/modules/Tonel/Loader/LoaderModule.Class.st new file mode 100644 index 00000000..e97bddbf --- /dev/null +++ b/modules/Tonel/Loader/LoaderModule.Class.st @@ -0,0 +1,34 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #LoaderModule category: #Tonel! +Module subclass: #LoaderModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tonel'! +!LoaderModule commentStamp: '' prior: 0! + + Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LoaderModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! +imports + ^{ + #Kernel -> #(IdentitySet Module). + #Compiler -> #SCompiler + } +! ! + +!LoaderModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:40'! +start + +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'LoaderModule class' category: #Tonel! +LoaderModule class + instanceVariableNames: ''! + + diff --git a/modules/Tonel/Loader/TonelLoader.Class.st b/modules/Tonel/Loader/TonelLoader.Class.st new file mode 100644 index 00000000..3ddba4e4 --- /dev/null +++ b/modules/Tonel/Loader/TonelLoader.Class.st @@ -0,0 +1,163 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TonelLoader category: #Tonel! +Object subclass: #TonelLoader + instanceVariableNames: 'moduleDir' + classVariableNames: '' + poolDictionaries: '' + category: 'Tonel'! +!TonelLoader commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!TonelLoader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +findModulePath: moduleName + | parts path candidates dir | + parts := '.' split: moduleName. + path := ('/' join: parts) asFilename. + candidates := moduleDir allDirectoriesMatching: parts first. + candidates do: [:match | + dir := match parent / path asString. + dir exists ifTrue: [ ^moduleDir / dir ]]. + self error: 'module ' , moduleName , ' couldn''t be found' +! ! + +!TonelLoader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +classesSortedBySuperclass: anArray + | result seen s dfs | + result := OrderedCollection new. + seen := IdentitySet new. + dfs := [ :class | + s := class superclass. + ((anArray includes: s) andNot: [ seen includes: s ]) ifTrue: [ + dfs value: s ]. + result add: class. + seen add: class ]. + anArray do: [ :class | (seen includes: class) ifFalse: [ dfs value: class ] ]. + self ASSERT: result asSet = anArray asSet. + ^ result +! ! + +!TonelLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:40'! +createNewClassFrom: spec in: module + | supername superclass metaclass class | + supername := spec supername. + superclass := module + ifNil: [ (Kernel namespace at: supername) ] + ifNotNil: [ module namespace at: supername ]. + class := Class newSubclassOf: superclass. + metaclass := class class. + class name: spec name. + class instVarNames: spec instVarNames. + class classVariables: (self createNamespaceWith: spec classVars). + behaviors + at: spec put: class instanceBehavior; + at: spec metaclass put: metaclass instanceBehavior. + spec methods do: [ :m | self createNewMethod: m in: class ]. + spec metaclass methods do: [ :m | self createNewMethod: m in: metaclass ]. + module ifNotNil: [ + module addClass: class. + class module: module]. + ^ class +! ! + +!TonelLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:40'! +createExtensionMethodsOf: spec in: module + | name namespace class metaclass | + name := spec name. + namespace := module namespace. + class := namespace at: name. + metaclass := class behavior classBinding. + spec methods do: [ :m | | cm | + cm := self createNewMethod: m in: class. + module ifNotNil: [ module addExtension: cm ] ]. + spec metaclass methods do: [ :m | | cm | + cm := self createNewMethod: m in: metaclass. + module ifNotNil: [ module addExtension: cm ] ]. + ^ module +! ! + +!TonelLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:40'! +createNewMethod: m in: species + | method selector | + method := SCompiler new compile: m sourceCode. + selector := method selector. + method classBinding: species. + species methodDictionary at: selector put: smethod. + species organization classify: selector under: category. + ^ method +! ! + +!TonelLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:40'! +createNewModule: spec class: class + | module | + module := class new. + module bindKernelExports; importRequiredModules. + spec name !!= #Module ifTrue: [ class module: module. module addClass: class]. + ^ module +! ! + +!TonelLoader methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadModule: symbol + | spec classes moduleName moduleSpec moduleClass module | + spec := self readModuleSpec: symbol. + classes := self classesSortedBySuperclass: spec classes. + moduleName := ('.' split: symbol) last asSymbol. + moduleSpec := spec at: moduleName , #Module. + moduleSpec ifNil: [ moduleSpec := spec at: #Module , moduleName ]. + moduleSpec + ifNil: [ + moduleClass := Module. + moduleSpec := Module spec ] + ifNotNil: [ + moduleClass := self createNewClassFrom: moduleSpec in: nil. + classes remove: moduleSpec ]. + module := self createNewModule: moduleSpec class: moduleClass. + module name isEmpty ifTrue: [ module name: symbol asString ]. + classes do: [ :classSpec | self createNewClassFrom: classSpec in: module ]. + spec extendedClasses do: [ :classSpec | self createExtensionMethodsOf: classSpec in: module ]. + module justLoaded. + ^ module +! ! + +!TonelLoader methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:40'! +readModuleSpec: aSymbol + | path | + path := self findModulePath: aSymbol. + ^path ifNotNil: [self readSpec: aSymbol at: path parent] +! ! + +!TonelLoader methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:40'! +readSpec: specName at: path + | dir subdir | + dir := self module path. + subdir := path isString ifTrue: [ path ] ifFalse: [ path asString ]. + subdir notEmpty ifTrue: [ dir := dir / subdir]. + + ^self readSpec: ('.' split: specName) last atDir: dir +! ! + +!TonelLoader methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:40'! +readSpec: specName atDir: dir + | definitions module classDefs methodDefs class | + definitions := (TonelReader on: dir fileName: specName) loadDefinitions; definitions. + + module := ModuleSpec new name: specName. + classDefs := definitions select: #isClassDefinition. + methodDefs := definitions select: #isMethodDefinition. + classDefs do: [ :cdef | module addClassFromDefinition: cdef]. + methodDefs do: [ :mdef | + class := module ensureClassNamed: mdef className. + class addMethodFromDefinition: mdef in: module ]. + ^ module +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TonelLoader class' category: #Tonel! +TonelLoader class + instanceVariableNames: ''! + + diff --git a/modules/Tonel/Module.Extension.st b/modules/Tonel/Module.Extension.st new file mode 100644 index 00000000..a5354720 --- /dev/null +++ b/modules/Tonel/Module.Extension.st @@ -0,0 +1,34 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! + + +!Module methodsFor: '*Tonel' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeSourceTo: aDirectoryPath + | writer | + self classes do: [:cls | + | filename contents | + contents := TonelWriter writeClass: cls category: self name. + filename := aDirectoryPath, '/', cls name, '.st'. + Kernel writeFile: filename contents: contents]. + self writeExtensionsTo: aDirectoryPath. + self writeModuleClassTo: aDirectoryPath +! ! + +!Module methodsFor: '*Tonel' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeExtensionsTo: aDirectoryPath + extensions keysAndValuesDo: [:key :methods | + | filename contents | + contents := TonelWriter writeMethods: methods. + filename := aDirectoryPath, '/', (key copyReplacing: ' ' with: '.'), '.st'. + Kernel writeFile: filename contents: contents] +! ! + +!Module methodsFor: '*Tonel' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeModuleClassTo: aDirectoryPath + | cls filename contents | + cls := self class. + contents := TonelWriter writeClass: cls category: self name. + filename := aDirectoryPath, '/', cls name, '.st'. + Kernel writeFile: filename contents: contents +! ! + + diff --git a/modules/Tonel/ReadStream.Extension.st b/modules/Tonel/ReadStream.Extension.st new file mode 100644 index 00000000..38fd7d19 --- /dev/null +++ b/modules/Tonel/ReadStream.Extension.st @@ -0,0 +1,25 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! + + +!ReadStream methodsFor: '*TonelReader' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextWordOrNumber + | c numeric token | + [ + self atEnd ifTrue: [^nil]. + c := self next. + c isAlphanumeric or: [c = $_]] whileFalse. + numeric := c isDigit. + token := String streamContents: [:strm | + strm nextPut: c. + [ + self atEnd not and: [ + c := self next. + numeric + ifTrue: [c isDigit] + ifFalse: [c isAlphanumeric or: [c = $_] or: [c = $.]]]] + whileTrue: [strm nextPut: c]]. + (numeric and: [c isLetter]) ifTrue: [self skip: -1]. + ^token first isDigit ifTrue: [token asInteger] ifFalse: [token] +! ! + + diff --git a/modules/Tonel/Tests/TestsModule.Class.st b/modules/Tonel/Tests/TestsModule.Class.st new file mode 100644 index 00000000..251efbb7 --- /dev/null +++ b/modules/Tonel/Tests/TestsModule.Class.st @@ -0,0 +1,41 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TestsModule category: #'Tonel.Tests'! +Module subclass: #TestsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tonel.Tests'! +!TestsModule commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!TestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! +imports + ^{ + #Kernel -> #(OrderedDictionary Error). + #Tonel -> #(TonelWriter TonelReader). + #SUnit -> #(TestCase TestSuite TestResult TestFailure) + } +! ! + +!TestsModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:40'! +main: anArray + | result | + Kernel log: 'Running ', self name, ' tests...'; log: String cr. + result := (TestSuite forModule: self) run. + Kernel + log: 'Done: ', result passedCount printString, ' passed, ', + (result failureCount + result errorCount) printString, ' failed.'; + log: String cr +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TestsModule class' category: #'Tonel.Tests'! +TestsModule class + instanceVariableNames: ''! + + diff --git a/modules/Tonel/Tests/TonelWriterTest.Class.st b/modules/Tonel/Tests/TonelWriterTest.Class.st new file mode 100644 index 00000000..a27de187 --- /dev/null +++ b/modules/Tonel/Tests/TonelWriterTest.Class.st @@ -0,0 +1,203 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TonelWriterTest category: #'Tonel.Tests'! +TestCase subclass: #TonelWriterTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tonel.Tests'! +!TonelWriterTest commentStamp: '' prior: 0! + + Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testWriteClassProducesOutput + | output | + output := TonelWriter writeClass: TonelWriter. + self assert: output notEmpty +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testWriteClassStartsWithClassType + | output | + output := TonelWriter writeClass: TonelWriter. + self assert: (output includesString: 'Class {') +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testWriteClassContainsClassName + | output | + output := TonelWriter writeClass: TonelWriter. + self assert: (output includesString: '#TonelWriter') +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testWriteClassContainsCategory + | output | + output := TonelWriter writeClass: TonelWriter category: 'Tonel'. + self assert: (output includesString: '#Tonel') +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testWriteClassContainsMethods + | output | + output := TonelWriter writeClass: TonelWriter. + self assert: (output includesString: 'TonelWriter >> ') +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testClassMethodsAppearBeforeInstanceMethods + | output classMethodPos instanceMethodPos | + output := TonelWriter writeClass: TonelWriter. + classMethodPos := output indexOfString: 'TonelWriter class >> '. + instanceMethodPos := output indexOfString: 'TonelWriter >> write ['. + self assert: classMethodPos > 0. + self assert: instanceMethodPos > 0. + self assert: classMethodPos < instanceMethodPos +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testMethodsAreSortedBySelector + | output lines methodLines selectors | + output := TonelWriter writeClass: TonelWriter. + lines := output lines. + methodLines := lines select: [:line | + (line includesString: 'TonelWriter >> ') and: [ + (line includesString: 'TonelWriter class >> ') not]]. + selectors := methodLines collect: [:line | + | start rest space | + start := line indexOfString: '>> '. + rest := line copyFrom: start + 3. + space := rest indexOf: $ . + space = 0 + ifTrue: [rest trimBlanks] + ifFalse: [(rest copyFrom: 1 to: space - 1) trimBlanks]]. + selectors size > 1 ifTrue: [ + 1 to: selectors size - 1 do: [:i | + self assert: (selectors at: i) <= (selectors at: i + 1)]] +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testRoundTrip + | output reader | + output := TonelWriter writeClass: TonelWriter category: 'Tonel'. + reader := TonelReader on: output readStream. + reader read. + self assert: true +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testReadMethodWithDollarDollarLiteral + "A method body containing $$ followed by a special character + (like [ or ]) must not confuse the block terminator scanner." + | input reader | + input := 'Class { #name : #Foo, #superclass : #Object, #category : #X } + +{ #category : #m } +Foo >> m [ + | c | c := $$. ^c == $[ +] +'. + reader := TonelReader on: input readStream. + reader read. + self assert: reader methods size equals: 1 +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testReadMethodWithDollarDollarFollowedByBracket + "After $$ the next character is a real source character that must be + honored for nesting. E.g. $$[:x|x] contains a real opening [ that the + scanner must count." + | input reader method | + input := 'Class { #name : #Foo, #superclass : #Object, #category : #X } + +{ #category : #m } +Foo >> m [ + ^$$ , [:x | x] value: 1 +] +'. + reader := TonelReader on: input readStream. + reader read. + self assert: reader methods size equals: 1. + method := reader methods first. + self assert: ((method at: #body) includesString: 'value: 1') +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testReadMethodBodyEndingWithDollarDollar + "$$ is a complete character literal (the $ char). The next character + (in this case the closing ]) is a real source character, not escaped. + Scanners that blindly treat 'prev = $' as escaping the next position + will fail to terminate here." + | input reader method | + input := 'Class { #name : #Foo, #superclass : #Object, #category : #X } + +{ #category : #m } +Foo >> m [ + ^$$] +'. + reader := TonelReader on: input readStream. + reader read. + self assert: reader methods size equals: 1. + method := reader methods first. + self assert: ((method at: #body) includesString: '$$') +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testReadUnterminatedBlockRaises + "An unterminated method body must raise an error, not hang nor silently truncate." + | input reader | + input := 'Class { #name : #Foo, #superclass : #Object, #category : #X } + +{ #category : #m } +Foo >> m [ + self foo. +'. + reader := TonelReader on: input readStream. + self should: [reader read] raise: Error +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testRoundTripWithUnicodeBody + "Non-ASCII characters in a method body must round-trip through the + reader without being lost or mangled." + | stream input reader method body nch | + nch := Character value: 241. + stream := String new writeStream. + stream nextPutAll: 'Class { #name : #Foo, #superclass : #Object, #category : #X }'; cr; cr. + stream nextPutAll: '{ #category : #m }'; cr. + stream nextPutAll: 'Foo >> m ['; cr. + stream tab; nextPutAll: '^'''; nextPut: nch; nextPutAll: ''''; cr. + stream nextPutAll: ']'; cr. + input := stream contents. + reader := TonelReader on: input readStream. + reader read. + self assert: reader methods size equals: 1. + method := reader methods first. + body := method at: #body. + self assert: (body includes: nch) +! ! + +!TonelWriterTest methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +testWriteMethodFirstLineHasNoExtraTabs + "Writer output for each method must start with `Class >> selector` at + column 0 (no leading tabs)." + | output lines headerLines tab | + output := TonelWriter writeClass: TonelWriter. + lines := output lines. + headerLines := lines select: [:line | line includesString: 'TonelWriter ']. + self assert: headerLines notEmpty. + tab := Character tab asString. + headerLines do: [:line | + self deny: (line beginsWith: tab)] +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TonelWriterTest class' category: #'Tonel.Tests'! +TonelWriterTest class + instanceVariableNames: ''! + + diff --git a/modules/Tonel/TonelModule.Class.st b/modules/Tonel/TonelModule.Class.st new file mode 100644 index 00000000..60a7c039 --- /dev/null +++ b/modules/Tonel/TonelModule.Class.st @@ -0,0 +1,24 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TonelModule category: #Tonel! +Module subclass: #TonelModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tonel'! +!TonelModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! +imports + ^{ + #STON -> #(#STONReader #STONWriter #STON). + #Compiler -> #(#SSmalltalkParser). + #Kernel -> #(#Module #OrderedDictionary #ReadStream) + } +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TonelModule class' category: #Tonel! +TonelModule class + instanceVariableNames: ''! + + diff --git a/modules/Tonel/TonelReader.Class.st b/modules/Tonel/TonelReader.Class.st new file mode 100644 index 00000000..51e1bfa6 --- /dev/null +++ b/modules/Tonel/TonelReader.Class.st @@ -0,0 +1,150 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TonelReader category: #Tonel! +Object subclass: #TonelReader + instanceVariableNames: 'class methods stream' + classVariableNames: '' + poolDictionaries: '' + category: 'Tonel'! +!TonelReader commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!TonelReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +definition + ^class +! ! + +!TonelReader methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + class := OrderedDictionary new. + methods := OrderedCollection new +! ! + +!TonelReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methods + ^methods +! ! + +!TonelReader methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBlock + | nested char start eol skipNext | + nested := 1. + skipNext := false. + start := stream skipLine; position. + [nested > 0] whileTrue: [ + stream atEnd ifTrue: [^self error: 'unterminated method body']. + char := stream next. + skipNext + ifTrue: [skipNext := false] + ifFalse: [ + char = $$ + ifTrue: [skipNext := true] + ifFalse: [ + char = $[ ifTrue: [nested := nested + 1]. + char = $] ifTrue: [nested := nested - 1]. + char = $' ifTrue: [self skipString]. + char = $" ifTrue: [self skipComment]]]]. + eol := stream eol size. + ^stream copyFrom: start + eol - 1 to: stream position - 1 +! ! + +!TonelReader methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:40'! +read + self + readComments; + readType; + readDefinition; + readMethods +! ! + +!TonelReader methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:40'! +readComments + | start | + stream skipSeparators. + stream peek = $" ifTrue: [ + stream next. + start := stream position. + self skipComment. + class at: #comment put: (stream contents copyFrom: start + 1 to: stream position - 1)] +! ! + +!TonelReader methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:40'! +readDefinition + STONReader new + on: stream skipSeparators; + parseMapDo: [:key :value | class at: key put: value] +! ! + +!TonelReader methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:40'! +readMethod + | metadata classname signature selector method | + metadata := STON fromStream: stream. + classname := stream skipSeparators; upToAll: '>>'. + signature := stream upTo: $[. + selector := SSmalltalkParser parseSelector: signature. + method := OrderedDictionary new. + method + addAll: metadata; + at: #class put: classname trimBlanks; + at: #signature put: signature trimBlanks; + at: #selector put: selector; + at: #body put: self nextBlock. + methods add: method +! ! + +!TonelReader methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:40'! +readMethods + [stream skipSeparators; atEnd] whileFalse: [self readMethod] +! ! + +!TonelReader methodsFor: 'reading' stamp: 'KenD 28/Jun/2026 13:27:40'! +readType + | type | + type := stream skipSeparators; nextWordOrNumber. + (type = 'Class' or: [type = 'Extension']) + ifFalse: [self error: 'unsupported type'] +! ! + +!TonelReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipComment + self skipToMatch: $" +! ! + +!TonelReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipString + self skipToMatch: $' +! ! + +!TonelReader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipToMatch: aCharacter + [| found | + found := stream skipTo: aCharacter. + found ifFalse: [self error: aCharacter storeString , ' end expected']. + stream peek = aCharacter ifTrue: [ + stream next. + found := false]. + found] whileFalse +! ! + +!TonelReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stream: aReadStream + stream := aReadStream +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TonelReader class' category: #Tonel! +TonelReader class + instanceVariableNames: ''! + +!TonelReader class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +on: aStream + ^self new stream: aStream +! ! + + +TonelReader initialize! + diff --git a/modules/Tonel/TonelWriter.Class.st b/modules/Tonel/TonelWriter.Class.st new file mode 100644 index 00000000..50149a0d --- /dev/null +++ b/modules/Tonel/TonelWriter.Class.st @@ -0,0 +1,246 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:27:40 pm'! +!classDefinition: #TonelWriter category: #Tonel! +Object subclass: #TonelWriter + instanceVariableNames: 'stream class category methods' + classVariableNames: '' + poolDictionaries: '' + category: 'Tonel'! +!TonelWriter commentStamp: '' prior: 0! + + Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!TonelWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +category: aString + category := aString +! ! + +!TonelWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +class: aClass + class := aClass +! ! + +!TonelWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +crtab + stream crtab +! ! + +!TonelWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +definition + | map supername ivars cvars | + map := OrderedDictionary new. + self isExtension + ifTrue: [^map + at: #name put: methods anyone classBinding name asSymbol; + yourself]. + supername := (class respondsTo: #supername) + ifTrue: [class supername] + ifFalse: [class superclass ifNotNil: [:c | c name]]. + map + at: #name put: class name asSymbol; + at: #superclass put: supername asSymbol. + class instancesHavePointers + ifTrue: [class instancesAreArrayed ifTrue: [map at: #type put: #variable]] + ifFalse: [map at: #type put: #bytes]. + ivars := class instVarNames asArray. + ivars isEmpty ifFalse: [map at: #instVars put: ivars]. + cvars := class classVarNames asSortedCollection asArray. + cvars isEmpty ifFalse: [map at: #classVars put: cvars]. + category notNil ifTrue: [map at: #category put: category asSymbol]. + ^map +! ! + +!TonelWriter methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isExtension + ^self type = 'Extension' +! ! + +!TonelWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methods + methods notNil ifTrue: [^methods]. + class isNil ifTrue: [^#()]. + ^class class methodDictionary asArray & class methodDictionary asArray +! ! + +!TonelWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methods: aCollection + methods := aCollection. + self ASSERT: (methods isEmptyOrNil or: [| classes | + classes := methods collect: #classBinding in: Set new. + classes size = 1 or: [ + classes size = 2 and: [| meta | + meta := classes detect: [:cls | cls isMetaclass] ifNone: nil. + meta notNil and: [classes anySatisfy: [:cls | cls = meta instanceClass]]]]]) +! ! + +!TonelWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sortedMethods + | classMethods instanceMethods | + classMethods := OrderedCollection new. + instanceMethods := OrderedCollection new. + self methods do: [:m | + m classBinding isMetaclass + ifTrue: [classMethods add: m] + ifFalse: [instanceMethods add: m]]. + classMethods sortBy: [:a :b | a selector <= b selector]. + instanceMethods sortBy: [:a :b | a selector <= b selector]. + ^classMethods asArray & instanceMethods asArray +! ! + +!TonelWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +position: aStream afterSelector: aSymbol + | c | + aSymbol arity = 0 + ifTrue: [aStream skipSeparators; skip: aSymbol size] + ifFalse: [ + aSymbol keywords do: [:part | + aStream skipSeparators; skip: part size; skipSeparators. + self skipIdentifierIn: aStream]]. + [ + aStream atEnd ifTrue: [^self]. + c := aStream peek. + c isSeparator andNot: [c isEndOfLine]] + whileTrue: [aStream next]. + c isEndOfLine ifTrue: [aStream next] +! ! + +!TonelWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipIdentifierIn: aStream + [aStream atEnd not and: [aStream peek isAlphaNumericOrUnderscore]] + whileTrue: [aStream next] +! ! + +!TonelWriter methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stream: aWriteStream + stream := aWriteStream +! ! + +!TonelWriter methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +type + ^class notNil ifTrue: ['Class'] ifFalse: ['Extension'] +! ! + +!TonelWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +write + self + writeComments; + writeType; + writeDefinition; + writeMethods +! ! + +!TonelWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeClass: aClass + self writeClass: aClass category: nil +! ! + +!TonelWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeClass: aClass category: aString + self + class: aClass; + category: aString; + methods: nil; + write +! ! + +!TonelWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeComments + | comment | + comment := class comment. + (comment isNil or: [comment isEmpty]) ifTrue: [^self]. + stream nextPut: $"; nextPutAll: comment; nextPut: $"; cr; cr +! ! + +!TonelWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeDefinition + (STONWriter on: stream) writeMap: self definition. + stream cr; cr +! ! + +!TonelWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeMethod: method + | source head body metadata | + source := method sourceObject. + source isNil ifTrue: [^self]. + source := source readStream. + self position: source afterSelector: method selector. + head := source copyFrom: 1 to: source position. + body := source upToEnd. + metadata := OrderedDictionary new. + metadata at: #category put: method category. + (STONWriter on: stream) writeMap: metadata. + stream cr; print: method classBinding name; nextPutAll: ' >> '. + head lines + do: [:line | stream nextPutAll: line] + separatedBy: [stream cr]. + stream nextPutAll: ' ['. + body := body readStream. + [ + stream cr; nextPutAll: body nextLine. + body atEnd] whileFalse. + stream + cr; + nextPutAll: ']'; + cr; + cr +! ! + +!TonelWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeMethods + self sortedMethods do: [:m | self writeMethod: m] +! ! + +!TonelWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeMethods: aCollection + self class: nil; methods: aCollection; write +! ! + +!TonelWriter methodsFor: 'writing' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeType + stream nextPutAll: self type; space +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'TonelWriter class' category: #Tonel! +TonelWriter class + instanceVariableNames: ''! + +!TonelWriter class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +on: aWriteStream + ^self new stream: aWriteStream +! ! + +!TonelWriter class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeClass: aClass + " + TonelWriter writeClass: Point + " + ^self writeClass: aClass category: nil +! ! + +!TonelWriter class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeClass: aClass category: aString + " + TonelWriter writeClass: Point category: 'Kernel' + " + | tonel | + tonel := '' writeStream. + (self on: tonel) writeClass: aClass category: aString. + ^tonel contents +! ! + +!TonelWriter class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +writeMethods: aCollection + " + TonelWriter writeMethods: Point methodDictionary asArray + " + | tonel | + tonel := '' writeStream. + (self on: tonel) writeMethods: aCollection. + ^tonel contents +! ! + + diff --git a/modules/Webside/ByteArray.Extension.st b/modules/Webside/ByteArray.Extension.st new file mode 100644 index 00000000..367c922d --- /dev/null +++ b/modules/Webside/ByteArray.Extension.st @@ -0,0 +1,23 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! + + +!ByteArray methodsFor: '*webside' stamp: 'KenD 28/Jun/2026 13:32:24'! +asBase64 + | alphabet result size triple | + alphabet := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'. + result := '' writeStream. + size := self size. + 1 to: size by: 3 do: [:i | + triple := (self at: i) << 16. + triple := triple bitOr: (self at: i+1 ifAbsent: [ 0 ]) << 8. + triple := triple bitOr: (self at: i+2 ifAbsent: [ 0 ]). + result + nextPut: (alphabet at: (triple >> 18 bitAnd: 63) + 1); + nextPut: (alphabet at: (triple >> 12 bitAnd: 63) + 1); + nextPut: (i+1 <= size ifTrue: [ alphabet at: ((triple >> 6 bitAnd: 63) + 1) ] ifFalse: [ $= ]); + nextPut: (i+2 <= size ifTrue: [ alphabet at: ((triple bitAnd: 63) + 1) ] ifFalse: [ $= ]) + ]. + ^result contents +! ! + + diff --git a/modules/Webside/Class.Extension.st b/modules/Webside/Class.Extension.st new file mode 100644 index 00000000..f6f70b55 --- /dev/null +++ b/modules/Webside/Class.Extension.st @@ -0,0 +1,28 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! + + +!Class methodsFor: '*webside' stamp: 'KenD 28/Jun/2026 13:32:24'! +fileOutOn: aStream + | symbol | + symbol := '#', self symbol printString. + aStream + nextPutAll: self superclass printString; + cr; + tab; + nextPutAll: self kindOfSubclass; + space; + nextPutAll: symbol; + cr; + tab. + self isBytes ifFalse: [ + aStream + nextPutAll: 'instanceVariableNames: '; + nextPutAll: self instanceVariableString storeString; + cr; + tab]. + aStream + nextPutAll: 'classVariableNames: '; + nextPutAll: self classVariableString storeString +! ! + + diff --git a/modules/Webside/CompiledMethod.Extension.st b/modules/Webside/CompiledMethod.Extension.st new file mode 100644 index 00000000..1a3148ec --- /dev/null +++ b/modules/Webside/CompiledMethod.Extension.st @@ -0,0 +1,29 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! + + +!CompiledMethod methodsFor: '*webside' stamp: 'KenD 28/Jun/2026 13:32:24'! +asWebsideJson + | json status | + json := super asWebsideJson. + json + at: 'selector' put: selector; + at: 'methodClass' put: class name; + at: 'category' put: self category; + at: 'source' put: self sourceObject; + at: 'author' put: self author; + at: 'timestamp' put: self timestamp; + at: 'package' put: self module name; + at: 'needsRecompilation' put: self needsRecompilation. + "self isTest ifTrue: [ + status := self propertyAt: #status ifAbsent: ['unknown']. + json at: 'status' put: status asString]." + ^json +! ! + +!CompiledMethod methodsFor: '*webside' stamp: 'KenD 28/Jun/2026 13:32:24'! +needsRecompilation + "FIXME: to be implemented" + ^false +! ! + + diff --git a/modules/Webside/Metaclass.Extension.st b/modules/Webside/Metaclass.Extension.st new file mode 100644 index 00000000..48d79f1c --- /dev/null +++ b/modules/Webside/Metaclass.Extension.st @@ -0,0 +1,12 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! + + +!Metaclass methodsFor: '*webside' stamp: 'KenD 28/Jun/2026 13:32:24'! +fileOutOn: aStream + aStream + nextPutAll: self name; + nextPutAll: ' instanceVariableNames: '; + nextPutAll: self instanceVariableString storeString +! ! + + diff --git a/modules/Webside/Object.Extension.st b/modules/Webside/Object.Extension.st new file mode 100644 index 00000000..db7ad477 --- /dev/null +++ b/modules/Webside/Object.Extension.st @@ -0,0 +1,26 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! + + +!Object methodsFor: '*webside' stamp: 'KenD 28/Jun/2026 13:32:24'! +groupBy: aspect + | answer key copy remove | + answer := Dictionary new. + (aspect arity = 0 or: [aspect isClosure and: [aspect arity = 1]]) ifTrue: [ + self do: [:each | + key := aspect evaluateWith: each. + (answer at: key ifAbsentPut: [OrderedCollection new]) add: each]. + ^answer]. + copy := IdentitySet withAll: self. + remove := IdentitySet new. + self do: [:each | + copy do: [:e | + (aspect evaluateWith: each with: e) ifTrue: [ + remove add: e. + (answer at: each ifAbsentPut: [OrderedCollection new]) add: e]]. + copy removeAll: remove. + remove removeAll]. + ^answer + +! ! + + diff --git a/modules/Webside/Species.Extension.st b/modules/Webside/Species.Extension.st new file mode 100644 index 00000000..f0019e48 --- /dev/null +++ b/modules/Webside/Species.Extension.st @@ -0,0 +1,22 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! + + +!Species methodsFor: '*webside' stamp: 'KenD 28/Jun/2026 13:32:24'! +asWebsideJson + ^super asWebsideJson + at: 'name' put: self name; + at: 'definition' put: self definitionString; + at: 'superclass' + put: (self superclass ifNotNil: [:c | c name]); + at: 'comment' put: self comment; + at: 'variable' put: self isVariable; + at: 'package' put: self module name; + yourself +! ! + +!Species methodsFor: '*webside' stamp: 'KenD 28/Jun/2026 13:32:24'! +definitionString + ^String streamContents: [:strm | self fileOutOn: strm] +! ! + + diff --git a/modules/Webside/WebsideAPI.Class.st b/modules/Webside/WebsideAPI.Class.st new file mode 100644 index 00000000..db2a5557 --- /dev/null +++ b/modules/Webside/WebsideAPI.Class.st @@ -0,0 +1,501 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #WebsideAPI category: #Webside! +Object subclass: #WebsideAPI + instanceVariableNames: 'request response' + classVariableNames: '' + poolDictionaries: '' + category: 'Webside'! +!WebsideAPI commentStamp: '' prior: 0! + + Copyright (c) 2025, Javier Pimás, Guillermo Amaral. + See (MIT) license in root directory. +! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +annotationsForMethod: method + ^OrderedCollection new +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +categories + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^class categories +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +classDefinition + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^class asWebsideJson +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +classes + | root tree classes names depth json | + root := self queryAt: 'root'. + root := root notNil + ifTrue: [self classNamed: root] + ifFalse: [self defaultRootClass]. + root ifNil: [^self notFound]. + tree := self queryAt: 'tree'. + tree = 'true' ifTrue: [ + depth := self queryAt: 'depth' ifPresent: [:d | d asInteger]. + json := self classTreeFrom: root depth: depth. + ^Array with: json]. + classes := root withAllSubclasses. + names := self queryAt: 'names'. + names = 'true' ifTrue: [^(classes collect: [:c | c name]) sort]. + ^classes collect: [:c | c asWebsideJson] +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +classNamed: aString + | name metaclass class | + name := aString. + metaclass := name endsWith: ' class'. + metaclass ifTrue: [name := name trimTail: ' class']. + class := Kernel namespace at: name asSymbol ifAbsent: [^nil]. + class isSpecies ifFalse: [^nil]. + ^metaclass ifTrue: [class class] ifFalse: [class] +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +classTreeFrom: aClass depth: anInteger + | json subclasses depth names | + names := self queryAt: 'names'. + json := names = 'true' + ifTrue: [ + self newJsonObject + at: 'name' put: aClass name; + at: 'superclass' + put: (aClass superclass ifNotNil: [:c | c name]); + yourself] + ifFalse: [aClass asWebsideJson]. + (anInteger notNil and: [anInteger = 0]) ifTrue: [^json]. + depth := anInteger notNil ifTrue: [anInteger - 1]. + subclasses := (aClass subclasses sortBy: #name) + collect: [:c | self classTreeFrom: c depth: depth]. + json at: 'subclasses' put: subclasses. + ^json +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +classVariables + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^class withAllSuperclasses gather: [:c | + c classVarNames asArray sort collect: [:v | + self newJsonObject + at: 'name' put: v; + at: 'class' put: c name , ' class'; + at: 'type' put: 'class'; + yourself]] +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +colors + ^JsonObject new + at: 'primary' put: '#81C784'; + at: 'secondary' put: '#2E7D32'; + yourself +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +defaultRootClass + ^ProtoObject +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +dialect + ^'Egg' +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +instanceVariables + | class | + class := self requestedClass. + class isNil ifTrue: [^self notFound]. + ^class withAllSuperclasses + gather: [:c | + c instVarNames collect: [:n | + self newJsonObject + at: 'name' put: n; + at: 'class' put: c name; + at: 'type' put: 'instance'; + yourself]] + in: OrderedCollection new +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +jsonFromMethods: aCollection + | bytecodes disassembly ast annotations overriding overriden | + (self queryAt: 'basic') = 'true' ifTrue: [ + ^aCollection collect: [:m | + self newJsonObject + at: 'selector' put: m selector; + at: 'methodClass' put: m classBinding name; + at: 'category' put: m category; + at: 'package' put: m module name; + at: 'source' put: m sourceCode; + yourself]]. + bytecodes := (self queryAt: 'bytecodes') = 'true'. + disassembly := (self queryAt: 'disassembly') = 'true'. + ast := (self queryAt: 'ast') = 'true'. + annotations := (self queryAt: 'annotations') = 'true'. + overriding := self methodsRedefiningFrom: aCollection. + overriden := self methodsRedefinedFrom: aCollection. + ^aCollection collect: [:m | | json bcs | + json := m asWebsideJson. + json + at: 'overriding' put: (overriding includes: m); + at: 'overriden' put: (overriden includes: m). + bytecodes ifTrue: [ + bcs := [m treecodeString asString] on: Error do: ['']. + json at: 'bytecodes' put: bcs]. + + ast ifTrue: [json at: 'ast' put: m ast asWebsideJson]. + annotations + ifTrue: [json at: 'annotations' put: (self annotationsForMethod: m)]. + json] +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +logo + ^(Kernel host readFile: 'logo.png') asByteArray asBase64 -> 'image/png' +! ! + +!WebsideAPI methodsFor: 'code endpoints' stamp: 'KenD 28/Jun/2026 13:32:24'! +method + | method json | + method := self requestedMethod. + method ifNil: [^self notFound]. + json := self jsonFromMethods: (Array with: method). + ^json anyone +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +methods + | search methods | + search := self methodSearch. + search ifNil: [^#()]. + methods := search search collect: #contents. + (self queryAt: 'count') = 'true' ifTrue: [^methods size]. + ^self jsonFromMethods: methods +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +methodSearch + | scope search class | + scope := self methodSearchScope. + scope ifNil: [^nil]. + search := MethodSearch new. + search scope: scope. + self + queryAt: 'selector' + ifPresent: [:s | search := search withSelector: s asSymbol]; + queryAt: 'selectorMatching' + ifPresent: [:s | search := search withSelectorMatching: s asSymbol]. + self + queryAt: 'sending' + ifPresent: [:s | search := search sending: s asSymbol]. + self queryAt: 'referencingClass' ifPresent: [:n | + class := self classNamed: n. + class ifNil: [^nil]. + search := search referencingClass: class]. + self + queryAt: 'referencingString' + ifPresent: [:s | search := search referencingString: s]. + self queryAt: 'class' ifPresent: [:n | + class := self classNamed: n. + class ifNil: [^nil]. + search := search inClass: class; includeClassSide: false]. + self + queryAt: 'category' + ifPresent: [:c | search := search underCategory: c asSymbol]. + self + queryAt: 'accessing' + ifPresent: [:v | search := search referencingVariable: v]. + self queryAt: 'using' ifPresent: [:v | search := search usingVariable: v]. + self + queryAt: 'assigning' + ifPresent: [:v | search := search assigningVariable: v]. + ^search +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +methodsRedefinedFrom: aCollection + " + [WebsideAPI new methodsRedefinedFrom: Object methodDictionary values asArray] timeToRun + " + | redefined grouped | + redefined := OrderedCollection new. + grouped := aCollection groupBy: #classBinding. + grouped keysAndValuesDo: [:class :methods | + class allSubclassesDo: [:subclass | + methods removeAllSuchThat: [:m | | found | + found := subclass includesSelector: m selector. + found ifTrue: [redefined add: m]. + found]]]. + ^redefined +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +methodsRedefiningFrom: aCollection + " + WebsideAPI new methodsRedefiningFrom: Object methodDictionary values asArray + " + | redefining grouped | + redefining := OrderedCollection new. + grouped := aCollection groupBy: #classBinding. + grouped keysAndValuesDo: [:class :methods | + class allSuperclassesDo: [:subclass | + methods copy + select: [:m | subclass includesSelector: m selector] + thenDo: [:m | + redefining add: m. + methods remove: m]]]. + ^redefining +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +methodSearchScope + | name class | + name := (self urlAt: 'name') ifNil: [self queryAt: 'class']. + name ifNotNil: [ + class := self classNamed: name. + ^class + ifNotNil: [(MethodSearchScope class: class) includeClassSide: false] + ifNil: nil]. + self queryAt: 'hierarchy' ifPresent: [:h | + class := self classNamed: h. + ^class ifNotNil: [MethodSearchScope hierarchy: class] ifNil: nil]. + self queryAt: 'package' ifPresent: [:n | | project | + project := self packageNamed: n. + ^project ifNotNil: [MethodSearchScope project: project] ifNil: nil]. + ^MethodSearchScope new +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +newJsonObject + ^JsonObject new +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +notFound + response notFound. + ^nil +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +queryAt: aString + ^self queryAt: aString ifAbsent: nil +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +queryAt: aString ifAbsent: aBlock + ^self queryAt: aString ifPresent: nil ifAbsent: aBlock +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +queryAt: aString ifPresent: aBlock + ^self queryAt: aString ifPresent: aBlock ifAbsent: nil +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +queryAt: aString ifPresent: aBlock ifAbsent: anotherBlock + | value | + value := request queryAt: aString. + (value isNil or: [value isEmpty]) ifTrue: [^anotherBlock value]. + ^aBlock notNil ifTrue: [aBlock evaluateWith: value] ifFalse: [value]! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +request: aRequest + request := aRequest +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +requestedClass + | name | + name := self urlAt: 'name'. + ^name ifNotNil: [self classNamed: name] +! ! + +!WebsideAPI methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +requestedMethod + | class selector json | + class := self requestedClass. + class ifNil: [^nil]. + selector := self requestedSelector. + selector ifNil: [^nil]. + ^class >> selector +! ! + +!WebsideAPI methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:32:24'! +requestedSelector + | selector | + selector := self urlAt: 'selector'. + ^selector ifNotNil: [selector asSymbol] +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +response: aResponse + response := aResponse +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +search + | text ignoreCase position type results | + text := self queryAt: 'text' ifAbsent: [^self badRequest: 'missing text']. + ignoreCase := (self queryAt: 'ignoreCase') = 'true'. + position := (self queryAt: 'condition' ifAbsent: [#beginning]) asSymbol. + type := self queryAt: 'type' ifAbsent: 'all'. + results := CodeSearch + search: text + in: type + ignoreCase: ignoreCase + conditionType: position. + ^results collect: #asWebsideJson +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +subclasses + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^class subclasses collect: [:c | c asWebsideJson] +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +superclasses + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^class allSuperclasses collect: [:c | c asWebsideJson] +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +urlAt: aString + ^request paramAt: aString +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +usedCategories + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^self instanceVariables , self classVariables +! ! + +!WebsideAPI methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +usualCategories + | meta | + meta := self queryAt: 'meta'. + ^meta = 'true' + ifTrue: [#(#'instance creation' #accessing #validation #initialization #testing #'gui support' #constants #private #defaults #events #services #examples)] + ifFalse: [#(#accessing #actions #construction #'event handlers' #initialization #inquiries #printing #private #services #testing #updating #validation)] +! ! + +!WebsideAPI methodsFor: 'code endpoints' stamp: 'KenD 28/Jun/2026 13:32:24'! +variables + | class | + class := self requestedClass. + class ifNil: [^self notFound]. + ^self instanceVariables , self classVariables +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WebsideAPI class' category: #Webside! +WebsideAPI class + instanceVariableNames: ''! + +!WebsideAPI class methodsFor: 'routes' stamp: 'KenD 28/Jun/2026 13:32:24'! +addChangesRoutesTo: aWebApplication + aWebApplication + routeGET: '/changes' to: #changes; + routePOST: '/changes/update' to: #updateChanges; + routePOST: '/changes/compress' to: #compressChanges; + routePOST: '/changes' to: #addChange; + routePOST: '/changesets/download' + to: #downloadChangeset; + routePOST: '/changesets/upload' + to: #uploadChangeset; + routePOST: '/classes/{name}/methods' + to: #compileMethod; + routeDELETE: '/classes/{name}/methods/{selector}' + to: #removeMethod; + routePOST: '/classes' to: #defineClass; + routeDELETE: '/classes/{name}' to: #removeClass; + routePOST: '/packages' to: #addPackage; + routeDELETE: '/packages/{name}' to: #removePackage +! ! + +!WebsideAPI class methodsFor: 'routes' stamp: 'KenD 28/Jun/2026 13:32:24'! +addCodeRoutesTo: aWebApplication + aWebApplication + routeGET: '/packages' to: #packages; + routeGET: '/packages/{name}' to: #package; + routeGET: '/packages/{name}/classes' + to: #packageClasses; + routeGET: '/packages/{name}/methods' + to: #packageMethods; + routeGET: '/packages/{name}/unsent-methods' + to: #unsentMethods; + routeGET: '/packages/{name}/unimplemented-messages' + to: #unimplementedMessages; + routeGET: '/classes' to: #classes; + routeGET: '/classes/{name}' to: #classDefinition; + routeGET: '/classes/{name}/superclasses' + to: #superclasses; + routeGET: '/classes/{name}/subclasses' + to: #subclasses; + routeGET: '/classes/{name}/variables' + to: #variables; + routeGET: '/classes/{name}/instance-variables' + to: #instanceVariables; + routeGET: '/classes/{name}/class-variables' + to: #classVariables; + routeGET: '/classes/{name}/categories' + to: #categories; + routeGET: '/usual-categories' to: #usualCategories; + routeGET: '/classes/{name}/used-categories' + to: #usedCategories; + routeGET: '/classes/{name}/selectors' + to: #selectors; + routeGET: '/classes/{name}/methods' to: #methods; + routeGET: '/classes/{name}/methods/{selector}' + to: #method; + routeGET: '/methods' to: #methods; + routePOST: '/autocompletions' to: #autocompletions; + routeGET: '/search' to: #search; + routeGET: '/classes/{name}/methods/{selector}/history' + to: #methodHistory; + routeGET: '/classes/{name}/methods/{selector}/versions' + to: #methodVersions; + routeGET: '/classtemplate' to: #classTemplate; + routeGET: '/methodtemplate' to: #methodTemplate; + routePOST: '/selectors' to: #selectorInSource +! ! + +!WebsideAPI class methodsFor: 'routes' stamp: 'KenD 28/Jun/2026 13:32:24'! +addGeneralRoutesTo: aWebApplication + aWebApplication + routeGET: '/dialect' to: #dialect; + routeGET: '/logo' to: #logo; + routeGET: '/colors' to: #colors +! ! + +!WebsideAPI class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:32:24'! +addRoutesTo: aWebApplication + self + addGeneralRoutesTo: aWebApplication; + addCodeRoutesTo: aWebApplication; + addChangesRoutesTo: aWebApplication +! ! + + diff --git a/modules/Webside/WebsideApplication.Class.st b/modules/Webside/WebsideApplication.Class.st new file mode 100644 index 00000000..80c17d25 --- /dev/null +++ b/modules/Webside/WebsideApplication.Class.st @@ -0,0 +1,108 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #WebsideApplication category: #Webside! +Object subclass: #WebsideApplication + instanceVariableNames: 'name baseUri router api' + classVariableNames: '' + poolDictionaries: '' + category: 'Webside'! +!WebsideApplication commentStamp: '' prior: 0! + + Copyright (c) 2025, Javier Pimás. + See (MIT) license in root directory. +! + +!WebsideApplication methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +configure: anHttpServer + router := anHttpServer. + baseUri := '/egg'. + WebsideAPI addRoutesTo: self +! ! + +!WebsideApplication methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:32:24'! +expectsJson: anHttpRequest + | accept | + accept := anHttpRequest headersAt: 'Accept'. + ^accept notNil and: [accept includesString: 'application/json'] +! ! + +!WebsideApplication methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +handleGET: request into: response with: anEvaluable + | api result type contents | + api := WebsideAPI new + request: request; + response: response. + result := anEvaluable evaluateWith: api. + result isAssociation + ifTrue: [ + type := result value. + result := result key] + ifFalse: [ + (self expectsJson: request) + ifTrue: [ + type := 'application/json'. + result := JsonWriter write: result] + ifFalse: [type := 'text/html']]. + + contents := result isString ifTrue: [result] ifFalse: [result printString]. + result ifNotNil: [response setContents: contents type: type]. + response headersAt: 'Access-Control-Allow-Origin' put: '*' +! ! + +!WebsideApplication methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +routeDELETE: uri to: anEvaluable + "router routeDELETE: uri to: anEvaluable with: self" +! ! + +!WebsideApplication methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +routeGET: uri to: anEvaluable + router routeGET: baseUri, uri to: [:req :res | self handleGET: req into: res with: anEvaluable ] +! ! + +!WebsideApplication methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:32:24'! +routePOST: uri to: anEvaluable + "router routePOST: uri to: anEvaluable with: self" +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WebsideApplication class' category: #Webside! +WebsideApplication class + instanceVariableNames: ''! + +!WebsideApplication class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:32:24'! +apis + ^{WebsideAPI} +! ! + +!WebsideApplication class methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:24'! +appName + ^'Webside' +! ! + +!WebsideApplication class methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:24'! +defaultBaseUri + ^'/egg' +! ! + +!WebsideApplication class methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:24'! +defaultFrontendUrl + ^'http://localhost:3000' +! ! + +!WebsideApplication class methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:24'! +defaultPort + ^9000 +! ! + +!WebsideApplication class methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:24'! +frontendUrl + ^self defaultFrontendUrl +! ! + +!WebsideApplication class methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:32:24'! +on: anHttpServer + ^self new configure: anHttpServer +! ! + + diff --git a/modules/Webside/WebsideModule.Class.st b/modules/Webside/WebsideModule.Class.st new file mode 100644 index 00000000..82d2365a --- /dev/null +++ b/modules/Webside/WebsideModule.Class.st @@ -0,0 +1,45 @@ +'From Cuis7.9 [latest update: #7998] on 28 June 2026 at 1:32:24 pm'! +!classDefinition: #WebsideModule category: #Webside! +Module subclass: #WebsideModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Webside'! +!WebsideModule commentStamp: '' prior: 0! + + Copyright (c) 2025, Javier Pimás. + See (MIT) license in root directory. +! + +!WebsideModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:32:24'! +imports + ^{ + #Development -> #(CodeSearch MethodSearch MethodSearchScope). + #FFI -> #(ExternalLibrary). + #'HTTP.CPPHTTPServer' -> #(HTTPServer). + #Json -> #(JsonObject JsonWriter). + #Kernel -> #(ByteArray Error IdentitySet OrderedDictionary ProtoObject ReadStream Species) + } +! ! + +!WebsideModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:32:24'! +main: arguments + | server webside | + Kernel log: 'configuring server, initializing!!', String cr. + + ExternalLibrary module initializeForCurrentPlatform. + Kernel log: 'server configured, starting!!', String cr. + server := HTTPServer new. + webside := WebsideApplication on: server. + + server start +! ! + + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'WebsideModule class' category: #Webside! +WebsideModule class + instanceVariableNames: ''! + + From b540fba5a0715b2bf30c4c962e6427b3c72bac5d Mon Sep 17 00:00:00 2001 From: KenDickey Date: Tue, 30 Jun 2026 08:41:35 -0700 Subject: [PATCH 5/6] Egg Compiler port --- Cuis/Powerlang.pck.st | 11457 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 11457 insertions(+) create mode 100644 Cuis/Powerlang.pck.st diff --git a/Cuis/Powerlang.pck.st b/Cuis/Powerlang.pck.st new file mode 100644 index 00000000..3be4a21c --- /dev/null +++ b/Cuis/Powerlang.pck.st @@ -0,0 +1,11457 @@ +'From Cuis7.9 [latest update: #7998] on 30 June 2026 at 8:34:53 am'! +'Description Selected https://github.com/powerlang/egg/module classes transliterated via Cuis-Smalltalk-Tonel-Browser.'! +!provides: 'Powerlang' 1 3! +!requires: 'BeeCompatibility' 1 65 nil! +!requires: 'ExchangeFormat-Tonel-Lite' 1 73 nil! +SystemOrganization addCategory: 'Powerlang-ModuleSpecReader'! +SystemOrganization addCategory: 'Powerlang-CodeSpecs'! +SystemOrganization addCategory: 'Powerlang-ArgParser'! +SystemOrganization addCategory: 'Powerlang-EPM'! +SystemOrganization addCategory: #'Powerlang-Core-LMR'! +SystemOrganization addCategory: #'Powerlang-Core-SCompiler'! +SystemOrganization addCategory: #'Powerlang-Core-SCompiler-Bindings'! +SystemOrganization addCategory: #'Powerlang-Core-SCompiler-Smalltalk'! +SystemOrganization addCategory: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SystemOrganization addCategory: #'Powerlang-Core-SExpressions'! +SystemOrganization addCategory: #'Powerlang-Kernel'! +SystemOrganization addCategory: #'Powerlang-ModuleImporter'! +SystemOrganization addCategory: 'Powerlang-Compiler.Tests'! + + +!classDefinition: #SFFIDescriptor category: #'Powerlang-Core-SCompiler'! +ByteArray variableByteSubclass: #SFFIDescriptor + instanceVariableNames: '' + classVariableNames: 'FFICallingConventions FFITypes' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'SFFIDescriptor class' category: #'Powerlang-Core-SCompiler'! +SFFIDescriptor class + instanceVariableNames: 'FFICallingConventions FFITypes'! + +!classDefinition: #LMRArrayedCollection category: #'Powerlang-Kernel'! +ArrayedCollection subclass: #LMRArrayedCollection + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRArrayedCollection class' category: #'Powerlang-Kernel'! +LMRArrayedCollection class + instanceVariableNames: ''! + +!classDefinition: #LMRSymbol category: #'Powerlang-Kernel'! +Symbol variableByteSubclass: #LMRSymbol + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRSymbol class' category: #'Powerlang-Kernel'! +LMRSymbol class + instanceVariableNames: ''! + +!classDefinition: #WideSymbol category: #'Powerlang-Kernel'! +Symbol variableByteSubclass: #WideSymbol + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'WideSymbol class' category: #'Powerlang-Kernel'! +WideSymbol class + instanceVariableNames: ''! + +!classDefinition: #WideString category: #'Powerlang-Kernel'! +String variableByteSubclass: #WideString + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'WideString class' category: #'Powerlang-Kernel'! +WideString class + instanceVariableNames: ''! + +!classDefinition: #CharacterArray category: #'Powerlang-ModuleImporter'! +CharacterSequence subclass: #CharacterArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ModuleImporter'! +!classDefinition: 'CharacterArray class' category: #'Powerlang-ModuleImporter'! +CharacterArray class + instanceVariableNames: ''! + +!classDefinition: #LMRCharacterArray category: #'Powerlang-Kernel'! +CharacterArray subclass: #LMRCharacterArray + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRCharacterArray class' category: #'Powerlang-Kernel'! +LMRCharacterArray class + instanceVariableNames: ''! + +!classDefinition: #Namespace category: #'Powerlang-Kernel'! +Dictionary subclass: #Namespace + instanceVariableNames: 'parent' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'Namespace class' category: #'Powerlang-Kernel'! +Namespace class + instanceVariableNames: ''! + +!classDefinition: #WeakIdentityDictionary category: #'Powerlang-Kernel'! +Dictionary subclass: #WeakIdentityDictionary + instanceVariableNames: 'critical' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'WeakIdentityDictionary class' category: #'Powerlang-Kernel'! +WeakIdentityDictionary class + instanceVariableNames: ''! + +!classDefinition: #SCompilationError category: #'Powerlang-Core-SCompiler'! +Error subclass: #SCompilationError + instanceVariableNames: 'compiler resumable retryable stretch' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'SCompilationError class' category: #'Powerlang-Core-SCompiler'! +SCompilationError class + instanceVariableNames: ''! + +!classDefinition: #SInvalidPragmaError category: #'Powerlang-Core-SCompiler'! +SCompilationError subclass: #SInvalidPragmaError + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'SInvalidPragmaError class' category: #'Powerlang-Core-SCompiler'! +SInvalidPragmaError class + instanceVariableNames: ''! + +!classDefinition: #SUndeclaredIdentifierError category: #'Powerlang-Core-SCompiler'! +SCompilationError subclass: #SUndeclaredIdentifierError + instanceVariableNames: 'identifier assigned' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'SUndeclaredIdentifierError class' category: #'Powerlang-Core-SCompiler'! +SUndeclaredIdentifierError class + instanceVariableNames: ''! + +!classDefinition: #ArgParser category: 'Powerlang-ArgParser'! +Object subclass: #ArgParser + instanceVariableNames: 'name description commands globalOptions' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ArgParser'! +!classDefinition: 'ArgParser class' category: 'Powerlang-ArgParser'! +ArgParser class + instanceVariableNames: ''! + +!classDefinition: #Command category: 'Powerlang-ArgParser'! +Object subclass: #Command + instanceVariableNames: 'name description options positionalNames action subcommands' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ArgParser'! +!classDefinition: 'Command class' category: 'Powerlang-ArgParser'! +Command class + instanceVariableNames: ''! + +!classDefinition: #Option category: 'Powerlang-ArgParser'! +Object subclass: #Option + instanceVariableNames: 'short long description required hasValue defaultValue' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ArgParser'! +!classDefinition: 'Option class' category: 'Powerlang-ArgParser'! +Option class + instanceVariableNames: ''! + +!classDefinition: #ParseResult category: 'Powerlang-ArgParser'! +Object subclass: #ParseResult + instanceVariableNames: 'command positionals options' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ArgParser'! +!classDefinition: 'ParseResult class' category: 'Powerlang-ArgParser'! +ParseResult class + instanceVariableNames: ''! + +!classDefinition: #MethodSpec category: 'Powerlang-CodeSpecs'! +Object subclass: #MethodSpec + instanceVariableNames: 'selector class source category module ast' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-CodeSpecs'! +!classDefinition: 'MethodSpec class' category: 'Powerlang-CodeSpecs'! +MethodSpec class + instanceVariableNames: ''! + +!classDefinition: #ModuleSpec category: 'Powerlang-CodeSpecs'! +Object subclass: #ModuleSpec + instanceVariableNames: 'name description classes extendedClasses subclassifiedClasses imports dependencies' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-CodeSpecs'! +!classDefinition: 'ModuleSpec class' category: 'Powerlang-CodeSpecs'! +ModuleSpec class + instanceVariableNames: ''! + +!classDefinition: #SpeciesSpec category: 'Powerlang-CodeSpecs'! +Object subclass: #SpeciesSpec + instanceVariableNames: 'instanceVariables methods module format' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-CodeSpecs'! +!classDefinition: 'SpeciesSpec class' category: 'Powerlang-CodeSpecs'! +SpeciesSpec class + instanceVariableNames: ''! + +!classDefinition: #ClassSpec category: 'Powerlang-CodeSpecs'! +SpeciesSpec subclass: #ClassSpec + instanceVariableNames: 'name supername classVariables sharedPools metaclass variable pointers' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-CodeSpecs'! +!classDefinition: 'ClassSpec class' category: 'Powerlang-CodeSpecs'! +ClassSpec class + instanceVariableNames: ''! + +!classDefinition: #MetaclassSpec category: 'Powerlang-CodeSpecs'! +SpeciesSpec subclass: #MetaclassSpec + instanceVariableNames: 'class' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-CodeSpecs'! +!classDefinition: 'MetaclassSpec class' category: 'Powerlang-CodeSpecs'! +MetaclassSpec class + instanceVariableNames: ''! + +!classDefinition: #IdentifierBinder category: #'Powerlang-Core-SCompiler'! +Object subclass: #IdentifierBinder + instanceVariableNames: 'contents' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'IdentifierBinder class' category: #'Powerlang-Core-SCompiler'! +IdentifierBinder class + instanceVariableNames: ''! + +!classDefinition: #StaticBinder category: #'Powerlang-Core-SCompiler'! +IdentifierBinder subclass: #StaticBinder + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'StaticBinder class' category: #'Powerlang-Core-SCompiler'! +StaticBinder class + instanceVariableNames: ''! + +!classDefinition: #LocalEnvironment category: #'Powerlang-Core-SCompiler'! +Object subclass: #LocalEnvironment + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: 'ClosureElementTypes' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'LocalEnvironment class' category: #'Powerlang-Core-SCompiler'! +LocalEnvironment class + instanceVariableNames: ''! + +!classDefinition: #ArrayEnvironment category: #'Powerlang-Core-SCompiler'! +LocalEnvironment subclass: #ArrayEnvironment + instanceVariableNames: 'index' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'ArrayEnvironment class' category: #'Powerlang-Core-SCompiler'! +ArrayEnvironment class + instanceVariableNames: ''! + +!classDefinition: #StackEnvironment category: #'Powerlang-Core-SCompiler'! +LocalEnvironment subclass: #StackEnvironment + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'StackEnvironment class' category: #'Powerlang-Core-SCompiler'! +StackEnvironment class + instanceVariableNames: ''! + +!classDefinition: #ArgumentEnvironment category: #'Powerlang-Core-SCompiler'! +StackEnvironment subclass: #ArgumentEnvironment + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'ArgumentEnvironment class' category: #'Powerlang-Core-SCompiler'! +ArgumentEnvironment class + instanceVariableNames: ''! + +!classDefinition: #InlinedArgEnvironment category: #'Powerlang-Core-SCompiler'! +StackEnvironment subclass: #InlinedArgEnvironment + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'InlinedArgEnvironment class' category: #'Powerlang-Core-SCompiler'! +InlinedArgEnvironment class + instanceVariableNames: ''! + +!classDefinition: #MessageInliner category: #'Powerlang-Core-SCompiler'! +Object subclass: #MessageInliner + instanceVariableNames: 'message' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'MessageInliner class' category: #'Powerlang-Core-SCompiler'! +MessageInliner class + instanceVariableNames: ''! + +!classDefinition: #SCompilationResult category: #'Powerlang-Core-SCompiler'! +Object subclass: #SCompilationResult + instanceVariableNames: 'compiler error ast method' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'SCompilationResult class' category: #'Powerlang-Core-SCompiler'! +SCompilationResult class + instanceVariableNames: ''! + +!classDefinition: #SCompiler category: #'Powerlang-Core-SCompiler'! +Object subclass: #SCompiler + instanceVariableNames: 'errorHandler result class' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'SCompiler class' category: #'Powerlang-Core-SCompiler'! +SCompiler class + instanceVariableNames: ''! + +!classDefinition: #SParseTreeVisitor category: #'Powerlang-Core-SCompiler'! +Object subclass: #SParseTreeVisitor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'SParseTreeVisitor class' category: #'Powerlang-Core-SCompiler'! +SParseTreeVisitor class + instanceVariableNames: ''! + +!classDefinition: #SSemanticVisitor category: #'Powerlang-Core-SCompiler'! +SParseTreeVisitor subclass: #SSemanticVisitor + instanceVariableNames: 'inliner' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'SSemanticVisitor class' category: #'Powerlang-Core-SCompiler'! +SSemanticVisitor class + instanceVariableNames: ''! + +!classDefinition: #TreecodeEncoder category: #'Powerlang-Core-SExpressions'! +SParseTreeVisitor subclass: #TreecodeEncoder + instanceVariableNames: 'method stream script' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'TreecodeEncoder class' category: #'Powerlang-Core-SExpressions'! +TreecodeEncoder class + instanceVariableNames: ''! + +!classDefinition: #ScriptScope category: #'Powerlang-Core-SCompiler'! +Object subclass: #ScriptScope + instanceVariableNames: 'script arguments temporaries stackSize envSize captureSelf' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'ScriptScope class' category: #'Powerlang-Core-SCompiler'! +ScriptScope class + instanceVariableNames: ''! + +!classDefinition: #BlockScope category: #'Powerlang-Core-SCompiler'! +ScriptScope subclass: #BlockScope + instanceVariableNames: 'environments captured' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'BlockScope class' category: #'Powerlang-Core-SCompiler'! +BlockScope class + instanceVariableNames: ''! + +!classDefinition: #MethodScope category: #'Powerlang-Core-SCompiler'! +ScriptScope subclass: #MethodScope + instanceVariableNames: 'pseudo' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler'! +!classDefinition: 'MethodScope class' category: #'Powerlang-Core-SCompiler'! +MethodScope class + instanceVariableNames: ''! + +!classDefinition: #Binding category: #'Powerlang-Core-SCompiler-Bindings'! +Object subclass: #Binding + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'Binding class' category: #'Powerlang-Core-SCompiler-Bindings'! +Binding class + instanceVariableNames: ''! + +!classDefinition: #DynamicBinding category: #'Powerlang-Core-SCompiler-Bindings'! +Binding subclass: #DynamicBinding + instanceVariableNames: '' + classVariableNames: 'Default' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'DynamicBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +DynamicBinding class + instanceVariableNames: 'Default'! + +!classDefinition: #NestedDynamicBinding category: #'Powerlang-Core-SCompiler-Bindings'! +DynamicBinding subclass: #NestedDynamicBinding + instanceVariableNames: 'parent' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'NestedDynamicBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +NestedDynamicBinding class + instanceVariableNames: ''! + +!classDefinition: #LiteralBinding category: #'Powerlang-Core-SCompiler-Bindings'! +Binding subclass: #LiteralBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'LiteralBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +LiteralBinding class + instanceVariableNames: ''! + +!classDefinition: #FalseBinding category: #'Powerlang-Core-SCompiler-Bindings'! +LiteralBinding subclass: #FalseBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'FalseBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +FalseBinding class + instanceVariableNames: ''! + +!classDefinition: #NilBinding category: #'Powerlang-Core-SCompiler-Bindings'! +LiteralBinding subclass: #NilBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'NilBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +NilBinding class + instanceVariableNames: ''! + +!classDefinition: #TrueBinding category: #'Powerlang-Core-SCompiler-Bindings'! +LiteralBinding subclass: #TrueBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'TrueBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +TrueBinding class + instanceVariableNames: ''! + +!classDefinition: #LocalBinding category: #'Powerlang-Core-SCompiler-Bindings'! +Binding subclass: #LocalBinding + instanceVariableNames: 'index environment declaration' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'LocalBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +LocalBinding class + instanceVariableNames: ''! + +!classDefinition: #ArgumentBinding category: #'Powerlang-Core-SCompiler-Bindings'! +LocalBinding subclass: #ArgumentBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'ArgumentBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +ArgumentBinding class + instanceVariableNames: ''! + +!classDefinition: #TemporaryBinding category: #'Powerlang-Core-SCompiler-Bindings'! +LocalBinding subclass: #TemporaryBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'TemporaryBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +TemporaryBinding class + instanceVariableNames: ''! + +!classDefinition: #SelfBinding category: #'Powerlang-Core-SCompiler-Bindings'! +Binding subclass: #SelfBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'SelfBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +SelfBinding class + instanceVariableNames: ''! + +!classDefinition: #SuperBinding category: #'Powerlang-Core-SCompiler-Bindings'! +SelfBinding subclass: #SuperBinding + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Bindings'! +!classDefinition: 'SuperBinding class' category: #'Powerlang-Core-SCompiler-Bindings'! +SuperBinding class + instanceVariableNames: ''! + +!classDefinition: #SSmalltalkCompiler category: #'Powerlang-Core-SCompiler-Smalltalk'! +Object subclass: #SSmalltalkCompiler + instanceVariableNames: 'frontend source ast result headless blocks leaf activeScript' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk'! +!classDefinition: 'SSmalltalkCompiler class' category: #'Powerlang-Core-SCompiler-Smalltalk'! +SSmalltalkCompiler class + instanceVariableNames: ''! + +!classDefinition: #SSmalltalkParser category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +Object subclass: #SSmalltalkParser + instanceVariableNames: 'compiler scanner token next' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SSmalltalkParser class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSmalltalkParser class + instanceVariableNames: ''! + +!classDefinition: #SSmalltalkScanner category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +Object subclass: #SSmalltalkScanner + instanceVariableNames: 'compiler stream' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SSmalltalkScanner class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSmalltalkScanner class + instanceVariableNames: ''! + +!classDefinition: #SToken category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +Object subclass: #SToken + instanceVariableNames: 'compiler stretch comments' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SToken class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SToken class + instanceVariableNames: ''! + +!classDefinition: #SEndToken category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SToken subclass: #SEndToken + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SEndToken class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SEndToken class + instanceVariableNames: ''! + +!classDefinition: #SParseNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SToken subclass: #SParseNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SParseNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode class + instanceVariableNames: ''! + +!classDefinition: #SAssignmentNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SAssignmentNode + instanceVariableNames: 'assignees expression operators' + classVariableNames: 'Token' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SAssignmentNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SAssignmentNode class + instanceVariableNames: 'Token'! + +!classDefinition: #SBraceNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SBraceNode + instanceVariableNames: 'elements message' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SBraceNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SBraceNode class + instanceVariableNames: ''! + +!classDefinition: #SCascadeNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SCascadeNode + instanceVariableNames: 'receiver messages optimized' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SCascadeNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SCascadeNode class + instanceVariableNames: ''! + +!classDefinition: #SCommentNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SCommentNode + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SCommentNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SCommentNode class + instanceVariableNames: ''! + +!classDefinition: #SIdentifierNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SIdentifierNode + instanceVariableNames: 'name binding' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SIdentifierNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SIdentifierNode class + instanceVariableNames: ''! + +!classDefinition: #SLiteralNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SLiteralNode + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SLiteralNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SLiteralNode class + instanceVariableNames: ''! + +!classDefinition: #SNumberNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SLiteralNode subclass: #SNumberNode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SNumberNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SNumberNode class + instanceVariableNames: ''! + +!classDefinition: #SMessageNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SMessageNode + instanceVariableNames: 'selector receiver arguments inlined' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SMessageNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SMessageNode class + instanceVariableNames: ''! + +!classDefinition: #SCascadeMessageNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SMessageNode subclass: #SCascadeMessageNode + instanceVariableNames: 'cascade' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SCascadeMessageNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SCascadeMessageNode class + instanceVariableNames: ''! + +!classDefinition: #SReturnNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SReturnNode + instanceVariableNames: 'expression return' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SReturnNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SReturnNode class + instanceVariableNames: ''! + +!classDefinition: #SScriptNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SScriptNode + instanceVariableNames: 'statements arguments temporaries children scope' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SScriptNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SScriptNode class + instanceVariableNames: ''! + +!classDefinition: #SBlockNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SScriptNode subclass: #SBlockNode + instanceVariableNames: 'inlined index parent' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SBlockNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SBlockNode class + instanceVariableNames: ''! + +!classDefinition: #SMethodNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SScriptNode subclass: #SMethodNode + instanceVariableNames: 'selector pragma' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SMethodNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SMethodNode class + instanceVariableNames: ''! + +!classDefinition: #SSelectorNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SParseNode subclass: #SSelectorNode + instanceVariableNames: 'symbol keywords' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SSelectorNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSelectorNode class + instanceVariableNames: ''! + +!classDefinition: #SPragmaNode category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SToken subclass: #SPragmaNode + instanceVariableNames: 'type name info' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SPragmaNode class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SPragmaNode class + instanceVariableNames: ''! + +!classDefinition: #SSymbolicToken category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SToken subclass: #SSymbolicToken + instanceVariableNames: 'value' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SSymbolicToken class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSymbolicToken class + instanceVariableNames: ''! + +!classDefinition: #SDelimiterToken category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSymbolicToken subclass: #SDelimiterToken + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SDelimiterToken class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SDelimiterToken class + instanceVariableNames: ''! + +!classDefinition: #SStringToken category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SSymbolicToken subclass: #SStringToken + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SCompiler-Smalltalk-Parser'! +!classDefinition: 'SStringToken class' category: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! +SStringToken class + instanceVariableNames: ''! + +!classDefinition: #Config category: 'Powerlang-EPM'! +Object subclass: #Config + instanceVariableNames: 'project user merged' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-EPM'! +!classDefinition: 'Config class' category: 'Powerlang-EPM'! +Config class + instanceVariableNames: ''! + +!classDefinition: #ProjectGenerator category: 'Powerlang-EPM'! +Object subclass: #ProjectGenerator + instanceVariableNames: 'name dir' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-EPM'! +!classDefinition: 'ProjectGenerator class' category: 'Powerlang-EPM'! +ProjectGenerator class + instanceVariableNames: ''! + +!classDefinition: #LMRObject category: #'Powerlang-Kernel'! +Object subclass: #LMRObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRObject class' category: #'Powerlang-Kernel'! +LMRObject class + instanceVariableNames: ''! + +!classDefinition: #Module category: #'Powerlang-Kernel'! +Object subclass: #Module + instanceVariableNames: 'name version exports namespace hash cachedLookups classes extensions overriden requires' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'Module class' category: #'Powerlang-Kernel'! +Module class + instanceVariableNames: ''! + +!classDefinition: #ArgParserModule category: 'Powerlang-ArgParser'! +Module subclass: #ArgParserModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ArgParser'! +!classDefinition: 'ArgParserModule class' category: 'Powerlang-ArgParser'! +ArgParserModule class + instanceVariableNames: ''! + +!classDefinition: #CodeSpecsModule category: 'Powerlang-CodeSpecs'! +Module subclass: #CodeSpecsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-CodeSpecs'! +!classDefinition: 'CodeSpecsModule class' category: 'Powerlang-CodeSpecs'! +CodeSpecsModule class + instanceVariableNames: ''! + +!classDefinition: #TestsModule category: 'Powerlang-Compiler.Tests'! +Module subclass: #TestsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Compiler.Tests'! +!classDefinition: 'TestsModule class' category: 'Powerlang-Compiler.Tests'! +TestsModule class + instanceVariableNames: ''! + +!classDefinition: #CompilerModule category: #'Powerlang-Core-LMR'! +Module subclass: #CompilerModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-LMR'! +!classDefinition: 'CompilerModule class' category: #'Powerlang-Core-LMR'! +CompilerModule class + instanceVariableNames: ''! + +!classDefinition: #EPMModule category: 'Powerlang-EPM'! +Module subclass: #EPMModule + instanceVariableNames: 'args parser config' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-EPM'! +!classDefinition: 'EPMModule class' category: 'Powerlang-EPM'! +EPMModule class + instanceVariableNames: ''! + +!classDefinition: #LMRModule category: #'Powerlang-Kernel'! +Module subclass: #LMRModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRModule class' category: #'Powerlang-Kernel'! +LMRModule class + instanceVariableNames: ''! + +!classDefinition: #ModuleImporterModule category: #'Powerlang-ModuleImporter'! +Module subclass: #ModuleImporterModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ModuleImporter'! +!classDefinition: 'ModuleImporterModule class' category: #'Powerlang-ModuleImporter'! +ModuleImporterModule class + instanceVariableNames: ''! + +!classDefinition: #NumberParser category: #'Powerlang-Kernel'! +Object subclass: #NumberParser + instanceVariableNames: 'stream error return' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'NumberParser class' category: #'Powerlang-Kernel'! +NumberParser class + instanceVariableNames: ''! + +!classDefinition: #ObjectReference category: #'Powerlang-Kernel'! +Object subclass: #ObjectReference + instanceVariableNames: 'source sourceOffset target absolute' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'ObjectReference class' category: #'Powerlang-Kernel'! +ObjectReference class + instanceVariableNames: ''! + +!classDefinition: #Species category: #'Powerlang-Kernel'! +Object subclass: #Species + instanceVariableNames: 'superclass instanceBehavior format organization instanceVariables' + classVariableNames: 'Flags' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'Species class' category: #'Powerlang-Kernel'! +Species class + instanceVariableNames: 'Flags'! + +!classDefinition: #StarToken category: #'Powerlang-Kernel'! +Object subclass: #StarToken + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'StarToken class' category: #'Powerlang-Kernel'! +StarToken class + instanceVariableNames: ''! + +!classDefinition: #Stretch category: #'Powerlang-Kernel'! +Object subclass: #Stretch + instanceVariableNames: 'start end' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'Stretch class' category: #'Powerlang-Kernel'! +Stretch class + instanceVariableNames: ''! + +!classDefinition: #StringPattern category: #'Powerlang-Kernel'! +Object subclass: #StringPattern + instanceVariableNames: 'stream tokens' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'StringPattern class' category: #'Powerlang-Kernel'! +StringPattern class + instanceVariableNames: ''! + +!classDefinition: #Unicode category: #'Powerlang-Kernel'! +Object subclass: #Unicode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'Unicode class' category: #'Powerlang-Kernel'! +Unicode class + instanceVariableNames: ''! + +!classDefinition: #UTF16 category: #'Powerlang-Kernel'! +Unicode subclass: #UTF16 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'UTF16 class' category: #'Powerlang-Kernel'! +UTF16 class + instanceVariableNames: ''! + +!classDefinition: #UTF32 category: #'Powerlang-Kernel'! +Unicode subclass: #UTF32 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'UTF32 class' category: #'Powerlang-Kernel'! +UTF32 class + instanceVariableNames: ''! + +!classDefinition: #UTF8 category: #'Powerlang-Kernel'! +Unicode subclass: #UTF8 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'UTF8 class' category: #'Powerlang-Kernel'! +UTF8 class + instanceVariableNames: ''! + +!classDefinition: #ModuleLoader category: #'Powerlang-ModuleImporter'! +Object subclass: #ModuleLoader + instanceVariableNames: 'module spec' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ModuleImporter'! +!classDefinition: 'ModuleLoader class' category: #'Powerlang-ModuleImporter'! +ModuleLoader class + instanceVariableNames: ''! + +!classDefinition: #NameOfSubclass category: #'Powerlang-ModuleImporter'! +Object subclass: #NameOfSubclass + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ModuleImporter'! +!classDefinition: 'NameOfSubclass class' category: #'Powerlang-ModuleImporter'! +NameOfSubclass class + instanceVariableNames: ''! + +!classDefinition: #ModuleSpecReader category: 'Powerlang-ModuleSpecReader'! +Object subclass: #ModuleSpecReader + instanceVariableNames: 'module path metadata' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ModuleSpecReader'! +!classDefinition: 'ModuleSpecReader class' category: 'Powerlang-ModuleSpecReader'! +ModuleSpecReader class + instanceVariableNames: ''! + +!classDefinition: #MessageInlinerTest category: 'Powerlang-Compiler.Tests'! +TestCase subclass: #MessageInlinerTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Compiler.Tests'! +!classDefinition: 'MessageInlinerTest class' category: 'Powerlang-Compiler.Tests'! +MessageInlinerTest class + instanceVariableNames: ''! + +!classDefinition: #SmalltalkScannerTest category: 'Powerlang-Compiler.Tests'! +TestCase subclass: #SmalltalkScannerTest + instanceVariableNames: 'scanner' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Compiler.Tests'! +!classDefinition: 'SmalltalkScannerTest class' category: 'Powerlang-Compiler.Tests'! +SmalltalkScannerTest class + instanceVariableNames: ''! + +!classDefinition: #LMRClosure category: #'Powerlang-Kernel'! +ProtoObject subclass: #LMRClosure + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRClosure class' category: #'Powerlang-Kernel'! +LMRClosure class + instanceVariableNames: ''! + +!classDefinition: #LMRProtoObject category: #'Powerlang-Kernel'! +ProtoObject subclass: #LMRProtoObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRProtoObject class' category: #'Powerlang-Kernel'! +LMRProtoObject class + instanceVariableNames: ''! + +!classDefinition: #LMRSpecies category: #'Powerlang-Kernel'! +ProtoObject subclass: #LMRSpecies + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRSpecies class' category: #'Powerlang-Kernel'! +LMRSpecies class + instanceVariableNames: ''! + + +!LMRArrayedCollection commentStamp: '' prior: 0! +Copyright (c) 2023, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRSymbol commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!WideSymbol commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!WideString commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!LMRCharacterArray commentStamp: '' prior: 0! +Copyright (c) 2023, Javier Pimás. + See (MIT) license in root directory. +! + +!Namespace commentStamp: '' prior: 0! +Copyright (c) 2022 Javier Pimás. + See (MIT) license in root directory. +! + +!WeakIdentityDictionary commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ArgParser commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!Command commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!Option commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!ParseResult commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!MethodSpec commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ModuleSpec commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!SpeciesSpec commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ClassSpec commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!MetaclassSpec commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!MessageInliner commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!Config commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!ProjectGenerator commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRObject commentStamp: '' prior: 0! +Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!Module commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ArgParserModule commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!CodeSpecsModule commentStamp: '' prior: 0! +Copyright (c) 2022, Quorum Software. + See (MIT) license in root directory. +! + +!TestsModule commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!CompilerModule commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!EPMModule commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRModule commentStamp: '' prior: 0! +Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!ModuleImporterModule commentStamp: '' prior: 0! +Copyright (c) 2022, Quorum Software. + See (MIT) license in root directory. +! + +!NumberParser commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ObjectReference commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Species commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StarToken commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Stretch commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StringPattern commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Unicode commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!UTF16 commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!UTF32 commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!UTF8 commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ModuleLoader commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ModuleSpecReader commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!MessageInlinerTest commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!SmalltalkScannerTest commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRClosure commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRProtoObject commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRSpecies commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! +arguments: aCollection + self replaceFrom: 1 to: aCollection size with: aCollection +! ! + +!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! +callingConvention: anInteger + self at: self size put: anInteger +! ! + +!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! +return: anInteger + self at: self size - 1 put: anInteger +! ! + +!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + self initializeFFITypes; initializeCallingConventions +! ! + +!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeCallingConventions + FFICallingConventions := Dictionary new. + FFICallingConventions + at: 'cdecl' put: 20; + at: 'com' put: 21; + at: 'callback' put: 22 +! ! + +!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeFFITypes + FFITypes := Dictionary new. + FFITypes + at: 'uint8' put: 0; + at: 'sint8' put: 1; + at: 'uint16' put: 2; + at: 'sint16' put: 3; + at: 'uint32' put: 4; + at: 'sint32' put: 5; + at: 'uint64' put: 6; + at: 'sint64' put: 7; + + at: 'float' put: 8; + at: 'double' put: 9; + + at: 'uchar' put: 10; + at: 'schar' put: 11; + at: 'ushort' put: 12; + at: 'sshort' put: 13; + at: 'ulong' put: 14; + at: 'slong' put: 15; + at: 'ularge' put: 16; + at: 'large' put: 17; + at: 'longdouble' put: 18; + at: 'pointer' put: 19; + at: 'complex-float' put: 20; + at: 'complex-double' put: 21; + at: 'complex-longdouble' put: 22; + + at: 'void' put: 23 +! ! + +!SFFIDescriptor class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +ret: aString args: aCollection cc: ccName + | args return cc result | + args := aCollection + collect: [ :argname | + FFITypes + at: argname asString + ifAbsent: [ self error: 'undefined argument type ' , argname ] ]. + return := FFITypes + at: aString + ifAbsent: [ self error: 'undefined result type ' , aString ]. + cc := FFICallingConventions + at: ccName + ifAbsent: [ self error: 'unsupported calling convention ' , ccName ]. + result := self new: args size + 2. + ^ result + callingConvention: cc; + return: return; + arguments: args +! ! + +!LMRSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +flushCacheFor: species + GlobalDispatchCache current flush: self forSpecies: species. + SendSite flush: self +! ! + +!WideSymbol methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aString + ^UTF16 current isString: self lessThanOrEqualTo: aString +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asByteCharacters + | n result | + n := self size. + result := Symbol new: n. + 1 to: n do: [:i | | code char | + code := self codeAt: i. + char := code < 256 ifTrue: [code] ifFalse: [$? asInteger]. + result byteAt: i put: char]. + ^result +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asLowercase + ^UTF16 current lowercaseOf: self +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asString + | n string | + n := self size. + string := WideString new: n. + ^string replaceFrom: 1 to: n with: self +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asUppercase + ^UTF16 current uppercaseOf: self +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asWideSymbol + ^self +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + | cp | + cp := self checkIndex: index; codeAt: index. + ^Character value: cp +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index putCode: codePoint + ^self + checkIndex: index; + uLongAtOffset: index - 1 * 4 put: codePoint +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: index + | cp | + cp := self codeAt: index. + ^Character value: cp +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self _size // 4 +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^self size * 4 +! ! + +!WideSymbol methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicSize + ^self _size +! ! + +!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +codeAt: index + ^self uLongAtOffset: index - 1 * 4 +! ! + +!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +species + ^WideString +! ! + +!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +td1 + | m td1 | + m := self size. + td1 := Dictionary new: m. + m to: 1 by: -1 do: [:i | | code | + code := self uLongAtOffset: i - 1 * 4. + td1 at: code + 1 ifAbsentPut: [m - i + 1]]. + ^td1 +! ! + +!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isByteCompliant + ^false +! ! + +!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWide + ^true +! ! + +!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWideSymbol + ^true +! ! + +!WideSymbol class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +findInterned: aString + | symbol string | + string := aString reduced. + string == aString ifFalse: [^super findInterned: string]. + symbol := aString bytes changeClassTo: self. + ^SymbolTable lookup: symbol +! ! + +!WideSymbol class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +intern: aString + | symbol canonical | + aString isByteCompliant ifTrue: [^aString reduced asSymbol]. + symbol := aString bytes changeClassTo: self. + canonical := SymbolTable lookup: symbol. + canonical == nil ifTrue: [^SymbolTable add: symbol]. + ^canonical +! ! + +!WideString methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! +, aString + | n string | + aString isString ifFalse: [^super , aString]. + n := self size. + string := WideString new: n + aString size. + ^string + replaceBytesFrom: 1 to: self sizeInBytes with: self startingAt: 1; + replaceFrom: n + 1 to: string size with: aString startingAt: 1 +! ! + +!WideString methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +<= aString + ^UTF16 current isString: self lessThanOrEqualTo: aString +! ! + +!WideString methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + | hash | + hash := self size. + 0 + to: self sizeInBytes - 4 + by: 4 + do: [:i | hash := (hash hashMultiply: 16r19660D) + bitXor: (self uLongAtOffset: i)]. + ^hash +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asByteCharacters + | n result | + n := self size. + result := String new: n. + 1 to: n do: [:i | | code char | + code := self codeAt: i. + char := code < 256 ifTrue: [code] ifFalse: [$? asInteger]. + result byteAt: i put: char]. + ^result +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asLowercase + ^UTF16 current lowercaseOf: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asSymbol + ^WideSymbol intern: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asUppercase + ^UTF16 current uppercaseOf: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +asWideString + ^self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +existingSymbol + ^WideSymbol findInterned: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +reduced + ^self isByteCompliant ifTrue: [self asByteCharacters] ifFalse: [self] +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytes + ^self basicSize +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! +utf8Bytes + ^UTF8 current encode: self +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index + | cp | + cp := self checkIndex: index; codeAt: index. + ^Character value: cp +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: index putCode: codePoint + ^self + checkIndex: index; + uLongAtOffset: index - 1 * 4 put: codePoint +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: index + | cp | + cp := self codeAt: index. + ^Character value: cp +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: anInteger put: aCharacter + self at: anInteger putCode: aCharacter codePoint. + ^aCharacter +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +atValid: index putCode: codePoint + ^self uLongAtOffset: index - 1 * 4 put: codePoint +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +checkByteIndex: index + index isInteger ifFalse: [self error: 'strings are indexed by integers']. + (index between: 1 and: self sizeInBytes) + ifFalse: [self + error: 'index: ' , index printString , ' is outside of string bounds'] +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +codeAt: index + ^self uLongAtOffset: index - 1 * 4 +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromCodePoints: aCollection + 1 to: aCollection size do: [:i | | ci | + ci := aCollection at: i. + self at: i putCode: ci] +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexAt: anInteger + ^anInteger +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveULongAtOffset: offset +put: anInteger + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 3 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uLongAtValidOffset: offset put: anInteger +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +td1 + | m td1 | + m := self size. + td1 := Dictionary new: m. + m to: 1 by: -1 do: [:i | | code | + code := self codeAt: i. + td1 at: code + 1 ifAbsentPut: [m - i + 1]]. + ^td1 +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +at: anInteger put: aCharacter + self + checkCharacter: aCharacter; + at: anInteger putCode: aCharacter codePoint. + ^aCharacter +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger + ^self basicByteAt: anInteger +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicAt: anInteger put: anObject + ^self basicByteAt: anInteger put: anObject +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicSize + ^self _size +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: anInteger + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger <= self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^self _byteAt: anInteger +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +byteAt: position put: asciiValue + position _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= position and: [position <= self _size]) + ifFalse: [^self outOfBoundsIndex: position]. + (0 <= asciiValue and: [asciiValue < 256]) + ifFalse: [^self error: 'invalid character']. + ^self _byteAt: position put: asciiValue +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterSize + ^4 +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self basicSize // 4 +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +composeCharacters + ^UTF16 current compose: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decomposeCharacters + ^UTF16 current decompose: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +foldDigits + ^UTF16 current foldDigitsOf: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +normalizeToC + ^UTF16 current normalizeToC: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +normalizeToD + ^(UTF16 current normalizeToD: self) reduced +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +normalizeToKC + ^UTF16 current normalizeToKC: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +normalizeToKD + ^UTF16 current normalizeToKD: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +unaccented + ^self normalizeToD reject: [:ch | ch isNonSpacingMark] +! ! + +!WideString methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexOfString: aString from: start to: stop td1: anArray + | m k | + m := aString size. + m = 0 ifTrue: [^0]. + k := start. + [k + m - 1 <= stop] whileTrue: [| i code delta | + i := 1. + [i <= m and: [(aString at: i) = (self at: k + i - 1)]] + whileTrue: [i := i + 1]. + i > m ifTrue: [^k]. + k + m > stop ifTrue: [^0]. + code := self codeAt: k + m. + delta := anArray at: code + 1 ifAbsent: nil. + delta isNil ifTrue: [delta := m + 1]. + k := k + delta]. + ^0 +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isByteCompliant + 1 to: self size do: [:i | | char | + char := self at: i. + char isByteCharacter ifFalse: [^false]]. + ^true +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCNormal + ^UTF16 current isCNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDNormal + ^UTF16 current isDNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isKCNormal + ^UTF16 current isKCNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isKDNormal + ^UTF16 current isKDNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWide + ^true +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isWideString + ^true +! ! + +!WideString methodsFor: 'inquires' stamp: 'KenD 28/Jun/2026 13:27:38'! +length + ^UTF16 current lengthOf: self +! ! + +!WideString methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printChunkOn: aStream from: anInteger + ^self printUTF8ChunkOn: aStream from: anInteger +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replace: anInteger with: aString + 1 to: anInteger do: [:i | | char | + char := aString at: i. + self at: i put: char] +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFirst: anInteger with: aString + 1 to: anInteger do: [:i | | char | + char := aString at: i. + self at: i put: char] +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop with: aString startingAt: position + | string | + string := self replacementFrom: aString. + super + replaceFrom: start - 1 * 4 + 1 + to: stop * 4 + with: string + startingAt: position - 1 * 4 + 1 +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replaceFrom: start to: stop withObject: aCharacter + self checkIndex: start; checkIndex: stop. + start to: stop do: [:i | self at: i put: aCharacter] +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! +replacementFrom: aString + | n wide | + aString class == self class ifTrue: [^aString]. + aString isExternalMemory ifTrue: [^WideString fromMemory: aString]. + n := aString size. + wide := WideString new: n. + 1 to: n do: [:i | | ch | + ch := aString atValid: i. + wide atValid: i put: ch]. + ^wide +! ! + +!WideString methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +uLongAtValidOffset: offset put: anInteger + anInteger size > 4 ifTrue: [self error: 'does not fit in 32 bits']. + self _uLongAtOffset: offset put: anInteger. + ^anInteger +! ! + +!WideString class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew: anInteger + ^self primitiveNewBytes: anInteger +! ! + +!WideString class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self basicNew: anInteger * 4 +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromBytes: aByteArray + ^UTF16 current + decodeStringFrom: aByteArray readStream + on: (self new: aByteArray size) +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromCodePoints: aCollection + | string | + string := self new: aCollection size. + ^string fromCodePoints: aCollection +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromExternalUTF16: anExternalMemory + ^UTF16 current decodeStringFrom: anExternalMemory readStream +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromExternalUTF16: anExternalMemory length: anInteger + | stream | + stream := anExternalMemory readStream. + stream readLimit: anInteger. + ^UTF16 current decodeStringFrom: stream +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromExternalUTF8: anExternalMemory + ^UTF8 current decodeStringFrom: anExternalMemory readStream +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromMemory: anExternalMemory + | s i | + s := self new: 1. + i := 1. + [ + s replaceBytesFrom: 1 to: 2 with: anExternalMemory startingAt: i. + (s codeAt: 1) = 0] + whileFalse: [i := i + 2]. + ^self fromMemory: anExternalMemory length: i - 1 // 2 +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromMemory: anExternalMemory length: anInteger + | bytes | + bytes := anExternalMemory readStream readLimit: anInteger * 2. + ^UTF16 current decodeStringFrom: bytes on: (self new: anInteger) +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromMultiByte: aByteArray codePage: anInteger + " + WideString fromMultiByte: #[16rFA] codePage: 1251 + " + | bytes string | + bytes := aByteArray externalCopy. + string := self + fromMultiByteAddress: bytes + codePage: anInteger + size: aByteArray sizeInBytes. + bytes free. + ^string +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromString: aString + aString class == String ifTrue: [^aString asWideString]. + aString class == self ifTrue: [^aString]. + ^self fromUTF8: aString asString utf8 +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +fromUTF8: aByteArray + ^UTF8 current + decodeStringFrom: aByteArray readStream + on: (self new: aByteArray size) +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +stringFromMemory: anExternalMemory + | s i | + s := self new: 1. + i := 1. + [ + s replaceBytesFrom: 1 to: 2 with: anExternalMemory startingAt: i. + (s codeAt: 1) = 0] + whileFalse: [i := i + 2]. + ^UTF16 decodeFromAddress: anExternalMemory length: i - 1 // 2 +! ! + +!WideString class methodsFor: 'gs' stamp: 'KenD 28/Jun/2026 13:27:38'! +newFrom: aByteArray + ^aByteArray copy changeClassTo: self +! ! + +!WideString class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +stringsFromAddress: anExternalMemory + | strings memory | + strings := OrderedCollection new. + memory := anExternalMemory. + [(memory at: 1) = 0 and: [(memory at: 2) = 0]] whileFalse: [| s | + s := self stringFromMemory: memory. + strings add: s. + memory := memory + (s size + 1 * 2)]. + ^strings +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 29/Jun/2026 12:12:21'! +dosToUnix + ^self species streamContents: [:s | | source | + source := self readStream. + [source atEnd] whileFalse: [| c | + c := source next. + (c = `Character cr`) + ifTrue: [ + s nextPut: `Character lf`. + source next] + ifFalse: [s nextPut: c]]]! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 29/Jun/2026 12:11:33'! +unixToMac + | result | + result := self species new: self size. + self + withIndexDo: [:c :i | (c = `Character lf`) + ifTrue: [result at: i put: `Character cr`] + ifFalse: [result at: i put: c]]. + ^result! ! + +!LMRCharacterArray methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveSize + ^self _size +! ! + +!Namespace methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_namespaceLookup: aSymbol + | table | + table := namespace _basicAt: 2. + 2 + to: table _size + do: [:j | | assoc | + assoc := (table _basicAt: j). + assoc == nil ifFalse: [ + assoc key == aSymbol + ifTrue: [^table _basicAt: j + 1]]]. + ^nil +! ! + +!Namespace class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^super new +! ! + +!WeakIdentityDictionary methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! +add: anAssociation + self ASSERT: anAssociation class == Ephemeron. + ^self critical: [super add: anAssociation] +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationClass + ^Ephemeron new registry: self +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +critical: aBlock + | save | + save := critical. + critical := true. + ^[aBlock value] ensure: [critical := save] +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +equates: element with: ephemeron + ^element == ephemeron key +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +hashFor: element + ^element basicHash +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +keyCollector + ^IdentitySet new: self size +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +rescue: anEphemeron + critical + ifTrue: [anEphemeron activate] + ifFalse: [self removeKey: anEphemeron key ifAbsent: nil] +! ! + +!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +associationsDo: aBlock + self critical: [ + super associationsDo: [:ephemeron | | hold | + hold := ephemeron key. + hold notNil ifTrue: [aBlock value: ephemeron]]] +! ! + +!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +do: aBlock + self associationsDo: [:assoc | aBlock evaluateWith: assoc value] +! ! + +!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +ephemeronsDo: aBlock + self associationsDo: aBlock +! ! + +!WeakIdentityDictionary methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +onTable: aHashTable + critical := false. + super onTable: aHashTable +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beFatal + resumable := retryable := false +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beResumable + resumable := true +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beWarning + resumable := true +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler + ^compiler +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler: aCompiler + compiler := aCompiler. + compiler result error: self +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +description: aString + description := aString +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isResumable + ^resumable + +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +proceed + retryable := false. + compiler result beSuccessful. + self isResumable ifTrue: [ self resume ] ifFalse: [ self return ] +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +source + ^compiler sourceCode copyFrom: stretch start to: stretch end +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stretch + ^stretch +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stretch: aStretch + stretch := aStretch +! ! + +!SCompilationError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isUndeclaredAccess + ^false +! ! + +!SCompilationError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isUndeclaredAssignment + ^ false +! ! + +!SUndeclaredIdentifierError methodsFor: 'accessing-token' stamp: 'KenD 28/Jun/2026 13:27:40'! +assignment: aBoolean + assigned := aBoolean +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +identifier + ^ identifier +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isUndeclaredAccess + ^assigned not +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isUndeclaredAssignment + ^assigned +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stretch: aStretch + super stretch: aStretch. + identifier := self source +! ! + +!ArgParser methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:37'! +addCommand: aCommand + commands at: aCommand name put: aCommand +! ! + +!ArgParser methodsFor: 'options' stamp: 'KenD 28/Jun/2026 13:27:37'! +addGlobalOption: anOption + globalOptions add: anOption +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description + ^description +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description: aString + description := aString +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name + ^name +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name: aString + name := aString +! ! + +!ArgParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +extractGlobalArgs: args + | remaining i | + remaining := OrderedCollection new. + i := 1. + [i <= args size] whileTrue: [ + | arg match rest | + arg := args at: i. + match := globalOptions detect: [:opt | opt matches: arg] ifNone: [nil]. + match ifNotNil: [ + match hasValue ifTrue: [i := i + 1] + ] ifNil: [ + rest := args copyFrom: i to: args size. + ^remaining addAll: rest; yourself]. + i := i + 1]. + ^remaining +! ! + +!ArgParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parse: args + | remaining key command result tail | + remaining := self extractGlobalArgs: args. + remaining isEmpty ifTrue: [self printHelp. ^nil]. + key := remaining first. + command := commands at: key ifAbsent: [ + self error: 'Unknown command: ', key, '. Run with no args for help.']. + result := ParseResult new. + result command: key. + tail := remaining copyFrom: 2 to: remaining size. + command parse: tail into: result. + command action ifNotNil: [:act | act value: result]. + ^result +! ! + +!ArgParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + commands := OrderedDictionary new. + globalOptions := OrderedCollection new +! ! + +!ArgParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +printHelp + | text | + text := name ifNil: ['command']. + description ifNotNil: [ + text := text , ' - ' , description]. + text := text , String cr , String cr , 'Commands:' , String cr. + commands keysAndValuesDo: [:key :cmd | + text := text , ' ' , key. + cmd description ifNotNil: [:d | + text := text , ' - ' , d]. + text := text , String cr]. + Kernel log: text +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +action + ^action +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +action: aBlock + action := aBlock +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description + ^description +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description: aString + description := aString +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name + ^name +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name: aString + name := aString +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +options + ^options +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +positionalNames + ^positionalNames +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +subcommands + ^subcommands +! ! + +!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! +addOption: anOption + options add: anOption +! ! + +!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! +addPositional: aString + positionalNames add: aString +! ! + +!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! +addSubcommand: aCommand + subcommands at: aCommand name put: aCommand +! ! + +!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +applyDefaults: aResult + options do: [:opt | + (aResult hasOption: opt name) ifFalse: [ + opt defaultValue ifNotNil: [:v | + aResult setOption: opt name to: v]]] +! ! + +!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +checkRequired: aResult + options do: [:opt | + | name | + name := opt long ifNil: [opt short]. + (opt required and: [(aResult hasOption: opt name) not]) + ifTrue: [self error: 'Required option missing: ', name]] +! ! + +!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +findOption: aString + ^options detect: [:opt | opt matches: aString] ifNone: [nil] +! ! + +!Command methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasSubcommands + ^subcommands notEmpty +! ! + +!Command methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + options := OrderedCollection new. + positionalNames := OrderedCollection new. + subcommands := OrderedDictionary new +! ! + +!Command methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parse: args into: result + | i | + i := 1. + [i <= args size] whileTrue: [ + | arg | + arg := args at: i. + (arg first = $-) + ifTrue: [i := self parseOption: arg from: args at: i into: result] + ifFalse: [result addPositional: arg]. + i := i + 1]. + self checkRequired: result. + self applyDefaults: result +! ! + +!Command methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! +parseOption: aString from: anArray at: anInteger into: aResult + | opt | + opt := self findOption: aString. + opt ifNil: [self error: 'Unknown option: ', aString]. + opt hasValue ifTrue: [ + | val next | + next := anInteger + 1. + next > anArray size ifTrue: [self error: 'Option ', aString, ' requires a value']. + val := anArray at: next. + aResult setOption: opt name to: val. + ^next] + ifFalse: [ + aResult setOption: opt name to: true]. + ^anInteger +! ! + +!Command methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! +printUsageOn: aStream + aStream nextPutAll: name. + positionalNames do: [:pname | + aStream nextPutAll: ' <'; nextPutAll: pname; nextPut: $>]. + options do: [:opt | + aStream nextPutAll: ' ['. + opt short ifNotNil: [:s | aStream nextPutAll: s]. + (opt short notNil and: [opt long notNil]) ifTrue: [aStream nextPutAll: '|']. + opt long ifNotNil: [:l | aStream nextPutAll: l]. + opt hasValue ifTrue: [aStream nextPutAll: ' ']. + aStream nextPut: $]] +! ! + +!Option methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! +beFlag + hasValue := false. + defaultValue := false +! ! + +!Option methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! +beRequired + required := true +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +defaultValue + ^defaultValue +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +defaultValue: anObject + defaultValue := anObject +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description + ^description +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +description: aString + description := aString +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +long + ^long +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +long: aString + long := aString +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +name + long ifNotNil: [^long copyFrom: 3]. + ^short copyFrom: 2 +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +short + ^short +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +short: aString + short := aString +! ! + +!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasValue + ^hasValue +! ! + +!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +matches: aString + ^aString = short or: [aString = long] +! ! + +!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +required + ^required +! ! + +!Option methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + required := false. + hasValue := true. + defaultValue := nil +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +addPositional: aString + positionals add: aString +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +command + ^command +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +command: aString + command := aString +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +optionAt: aString + ^options at: aString ifAbsent: [nil] +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +optionAt: aString ifAbsent: aBlock + ^options at: aString ifAbsent: aBlock +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +options + ^options +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +positionalAt: anInteger + ^positionals at: anInteger +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +positionals + ^positionals +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! +setOption: aString to: aValue + options at: aString put: aValue +! ! + +!ParseResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! +hasOption: aString + ^options includesKey: aString +! ! + +!ParseResult methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! +initialize + positionals := OrderedCollection new. + options := OrderedDictionary new +! ! + +!MethodSpec methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! += aMethodSpec + ^aMethodSpec class = self class + and: [aMethodSpec selector == selector] + and: [aMethodSpec classBinding = class] +! ! + +!MethodSpec methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hash + ^class name hash hashWith: selector +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +asCompiledMethod + self canBeCompiled ifFalse: [^nil]. + ^self + propertyAt: #compiledMethod + ifAbsentPut: [self compiler compileMethod: source] +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +ast + self canBeCompiled ifFalse: [^nil]. + ^ast ifNil: [ast := self compiler parseMethod: source] +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +cannonicalAst + ^self halt propertyAt: #cannonicalAst ifAbsentPut: [self ast] +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! +referencedIdentifiers + ^self ast ifNil: [#()] ifNotNil: [:node | node identifiers] +! ! + +!MethodSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +bytecodes + ^self canBeCompiled ifTrue: [self asCompiledMethod bytecodes] +! ! + +!MethodSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +classname + ^class name +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +canBeCompiled + ^self compiler notNil +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +canBeParsed + ^self cannonicalAst notNil +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +equals: aMethodSpec + ^self canBeCompiled + and: [aMethodSpec canBeCompiled] + and: [self isFrameless not] + and: [self isEquivalentTo: aMethodSpec] +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isEquivalentTo: aMethodSpec + | m1 m2 | + selector == aMethodSpec selector ifFalse: [^false]. + class == aMethodSpec classBinding ifFalse: [^false]. + m1 := self asCompiledMethod. + m1 isNil ifTrue: [^false]. + m2 := aMethodSpec asCompiledMethod. + m2 isNil ifTrue: [^false]. + ^m1 equals: m2 +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isExtension + ^class isExtension +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isFrameless + ^self halt asCompiledMethod isFrameless +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +referencesIdentifier: aString + ^self referencedIdentifiers + anySatisfy: [:identifier | identifier name = aString] +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +usesInstanceVariableNamed: aString + ^(self ast variableNamed: aString) notNil +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +category + ^self isExtension + ifTrue: ['*' , (module name readStream upToLast: $-)] + ifFalse: [category] +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +category: aString + category := aString +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +classBinding + ^class +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +classBinding: aSpeciesSpec + class := aSpeciesSpec +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +module + ^module +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +module: aModuleSpec + module := aModuleSpec +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeFromClass + class removeMethod: self +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector + ^selector +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +selector: aSymbol + selector := aSymbol +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +source + ^source +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +source: aString + source := aString. + ast := nil +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +sourceCode + ^source +! ! + +!MethodSpec methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: class name asString , '>>#' , selector asString +! ! + +!MethodSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolveClass + ^module resolveClass: class name +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addClass: aClassSpec + classes add: aClassSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addClassExtension: aClassSpec + extendedClasses add: aClassSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addClasses: aCollection + aCollection do: [:c | self addClass: c] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addDependencies: aCollection + aCollection keysAndValuesDo: [:dep :objects | + dependencies + at: dep + put: objects + ifPresent: [:current | (current addAll: objects) withoutDuplicates]] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addSubclassifiedClass: aClassSpec + subclassifiedClasses addIfAbsent: aClassSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +associationAt: aSymbol ifAbsent: aBlock + ^imports associationAt: aSymbol ifAbsent: aBlock +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cleanDependencies + | needed | + needed := OrderedCollection new. + self methodReferences keys do: [:identifier | needed add: identifier name]. + self hierarchyReferences keys + do: [:identifier | needed add: identifier name]. + extendedClasses do: [:c | needed add: c name]. + dependencies copy keysAndValuesDo: [:module :identifiers | + (identifiers keys anySatisfy: [:identifier | needed includes: identifier]) + ifFalse: [dependencies removeKey: module]] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hierarchyReferences + | references | + references := Dictionary new. + self allClassesDo: [:c | | list | + c superclass ifNotNil: [ + list := references at: c superclass ifAbsentPut: [OrderedCollection new]. + list add: c]]. + ^references +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +methodReferences + | references | + references := Dictionary new. + self allMethodsDo: [:m | + m referencedIdentifiers reject: #isLocal thenDo: [:identifier | | list | + list := references at: identifier ifAbsentPut: [OrderedCollection new]. + list add: m]]. + ^references +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream + nextPut: $<; + print: name; + nextPutAll: '> module' +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeCategory: aSymbol inClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + class removeCategory: aSymbol +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + classes remove: class ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeEmptyExtensions + extendedClasses copy + reject: #hasMethods + thenDo: [:c | extendedClasses remove: c] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeExtendedClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + extendedClasses remove: class ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeMethod: aMethodSpec + self ASSERT: (self includesClass: aMethodSpec classBinding). + aMethodSpec classBinding removeMethod: aMethodSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSelectors: aCollection + self allClassesDo: [:c | + c removeSelectors: aCollection. + c metaclass removeSelectors: aCollection] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSelectors: aCollection inClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + class removeSelectors: aCollection +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSelectors: aCollection inScope: aClassSpec + | class all | + class := self resolveClass: aClassSpec. + all := self withAllSubclasses: class. + all do: [:c | c removeSelectors: aCollection] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSubclassesOf: aClassSpec + | class | + class := self resolveClass: aClassSpec. + class allSubclasses do: [:c | self removeClass: c; removeExtendedClass: c] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSubclassifiedClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + subclassifiedClasses remove: class ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +addImport: anAssociation + imports add: anAssociation +! ! + +!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +addImports: aCollection + aCollection do: [:token | self addImport: token asSymbol -> nil] +! ! + +!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + classes := OrderedCollection new. + extendedClasses := OrderedCollection new. + subclassifiedClasses := OrderedCollection new. + imports := Dictionary new. + dependencies := Dictionary new +! ! + +!ModuleSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +allClasses + ^classes , extendedClasses +! ! + +!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +allClassesDo: aBlock + classes do: aBlock. + extendedClasses do: aBlock +! ! + +!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +allMethods + | methods | + methods := OrderedCollection new. + self allMethodsDo: [:m | methods add: m]. + ^methods +! ! + +!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +allMethodsDo: aBlock + self allClassesDo: [:c | + c metaclass methods do: aBlock. + c methods do: aBlock] +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: aSymbol + ^self at: aSymbol ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +at: aSymbol ifAbsent: aBlock + | string | + string := aSymbol asString. + classes do: [:c | c name = string ifTrue: [^c]]. + extendedClasses do: [:c | c name = string ifTrue: [^c]]. + subclassifiedClasses do: [:c | c name = string ifTrue: [^c]]. + ^imports at: aSymbol ifAbsent: aBlock +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +classes + ^classes +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +dependencies + ^dependencies +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +dependencies: aDictionary + dependencies := aDictionary +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +description + ^description +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +description: aString + description := aString +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +extendedClasses + ^extendedClasses +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^name +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aString + name := aString +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +referencedGlobals + | referenced | + referenced := Dictionary new. + self allMethodsDo: [:m | + m referencedIdentifiers + select: [:identifier | | b | + b := identifier binding. + b refersToGlobal or: [b isUnresolved]] + thenDo: [:global | (referenced + at: global name + ifAbsentPut: [OrderedCollection new]) + add: m]]. + ^referenced +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +requiredImports + | required | + required := Dictionary new. + self referencedGlobals + keysAndValuesDo: [:global :dependents | (self definesGlobal: global) + ifFalse: [required at: global put: dependents]]. + ^required +! ! + +!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:27:39'! +basicResolveClass: aString + classes do: [:c | c name asString = aString ifTrue: [^c]]. + extendedClasses do: [:c | c name asString = aString ifTrue: [^c]]. + subclassifiedClasses do: [:c | c name asString = aString ifTrue: [^c]]. + ^nil +! ! + +!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:27:39'! +definesGlobal: aString + ^classes anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:27:39'! +resolveClass: class + | moniker metaclass found | + moniker := class isString ifTrue: [class] ifFalse: [class name]. + metaclass := moniker endsWith: ' class'. + metaclass ifTrue: [moniker := moniker trimTail: ' class']. + found := self basicResolveClass: moniker. + ^found ifNotNil: [metaclass ifTrue: [found metaclass] ifFalse: [found]] +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +definesClassNamed: aString + ^classes anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +extendsClassNamed: aString + ^extendedClasses anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +includesClass: aClassSpec + ^(self resolveClass: aClassSpec) notNil +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +subclassifiesClassNamed: aString + ^subclassifiedClasses anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! +sortedClasses + | remaining sorted | + remaining := classes copy. + sorted := OrderedCollection new. + [remaining isEmpty] whileFalse: [| c | + c := remaining first. + (remaining includes: c superclass) + ifTrue: [remaining removeFirst; add: c] + ifFalse: [ + remaining remove: c. + sorted add: c]]. + ^sorted +! ! + +!ModuleSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! +withAllSubclasses: aClassSpec + | all | + all := self allClasses. + aClassSpec isMetaclass ifTrue: [all := all collect: #metaclass]. + ^all select: [:c | c withAllSuperclasses includes: aClassSpec] +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMethod: aMethodSpec + ^methods add: aMethodSpec +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +addMethods: aCollection + aCollection do: [:m | self addMethod: m] +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeCategory: aSymbol + methods removeAllSuchThat: [:m | m category == aSymbol] +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeMethod: aMethodSpec + methods remove: aMethodSpec ifAbsent: nil +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSelector: aSymbol + methods removeAllSuchThat: [:m | m selector == aSymbol] +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! +removeSelectors: aCollection + methods removeAllSuchThat: [:m | aCollection includes: m selector] +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +allInstVarNames + ^(self withAllSuperclasses reversed gather: [:c | c instVarNames]) asArray +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSharedPools + | pools | + pools := Set new. + self withAllSuperclasses do: [:c | pools addAll: c sharedPools]. + ^pools +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSuperclasses + | superclasses | + superclasses := OrderedCollection new. + self allSuperclassesDo: [:s | superclasses add: s]. + ^superclasses +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +withAllSuperclasses + ^OrderedCollection with: self withAll: self allSuperclasses +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSubclasses + | all | + all := OrderedCollection new. + self allSubclassesDo: [:cls | all add: cls]. + ^all +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSubclassesDo: aBlock + self subclasses do: [:class | + aBlock value: class. + class allSubclassesDo: aBlock] +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +beArrayed + format := format | IsArrayed +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +beBytes + format := format | IsBytes +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instVarNames + ^instanceVariables +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instVarNames: aCollection + instanceVariables := aCollection asOrderedCollection +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +ivars: aCollection + instanceVariables := aCollection asOrderedCollection +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +methods + ^methods +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +module: aModuleSpec + module := aModuleSpec +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +selectors + ^methods collect: #selector +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +subclasses + ^module allClasses select: [:c | c supername = self name] +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +withAllSubclasses + ^OrderedCollection with: self withAll: self allSubclasses +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasMethods + ^methods notEmpty +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instancesAreArrayed + ^format anyMask: IsArrayed +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instancesHavePointers + ^(format anyMask: IsBytes) not +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isExtension + ^module extendedClasses includes: self instanceClass +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMetaclass + ^false +! ! + +!SpeciesSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + methods := OrderedCollection new. + instanceVariables := #(). + format := 0 +! ! + +!SpeciesSpec methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! +printOn: aStream + aStream nextPutAll: '<' , self name , '>' +! ! + +!SpeciesSpec class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initializeFormatMasks + self addNamespaceAs: #Format. + Format + at: 'IsArrayed' put: 0x1; + at: 'IsBytes' put: 0x2 +! ! + +!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +allMethods + ^methods & metaclass methods +! ! + +!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +classVarNames + ^classVariables keys +! ! + +!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +metaMethods + ^metaclass methods +! ! + +!ClassSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSuperclassesDo: aBlock + | s | + supername isNil ifTrue: [^self]. + s := self superclass. + s isNil ifTrue: [^self]. + aBlock value: s. + s allSuperclassesDo: aBlock +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +classVariables + ^classVariables +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +configureCompiler: aCompiler + +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cvarNames: aCollection + aCollection do: [:cvar | classVariables at: cvar put: nil] +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +cvars: aCollection + classVariables := aCollection +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instanceClass + ^self +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPointers + ^pointers +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isPointers: aBoolean + pointers := aBoolean +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isVariable + ^variable +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isVariable: aBoolean + variable := aBoolean +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +metaclass + ^metaclass +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +metaclass: aMetaclassSpec + metaclass := aMetaclassSpec +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^name +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +name: aString + name := aString +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +sharedPools + ^sharedPools +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +sharedPools: aCollection + sharedPools addAll: aCollection +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +superclass + supername ifNil: [^nil]. + ^module resolveClass: supername +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +supername + ^supername +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +supername: aString + supername := aString +! ! + +!ClassSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +hasMethods + ^super hasMethods or: [metaclass hasMethods] +! ! + +!ClassSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! +initialize + super initialize. + classVariables := OrderedDictionary new. + sharedPools := OrderedCollection new +! ! + +!MetaclassSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! +allSuperclassesDo: aBlock + | s c | + class supername isNil ifTrue: [ + c := module resolveClass: 'Class'. + c ifNil: [c := Class]. + c allSuperclassesDo: aBlock]. + s := self superclass. + s isNil ifTrue: [^self]. + aBlock value: s. + s allSuperclassesDo: aBlock +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +classVarNames + ^class classVarNames +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +metaMethods + ^#() +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +name + ^class name , ' class' +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +sharedPools + ^class sharedPools +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +superclass + ^class superclass ifNotNil: [:c | c metaclass] +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! +supername + ^self superclass name +! ! + +!MetaclassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instanceClass + ^class +! ! + +!MetaclassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! +instanceClass: aClassSpec + class := aClassSpec +! ! + +!MetaclassSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! +isMetaclass + ^true +! ! + +!IdentifierBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +contents + ^contents +! ! + +!IdentifierBinder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +keyFor: aString + ^self subclassResponsibility +! ! + +!IdentifierBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + self printOn: aStream indent: 0 +! ! + +!IdentifierBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream indent: anInteger + self subclassResponsibility +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: aString + ^contents at: aString ifAbsent: nil +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: aString ifAbsentPut: aBlock + ^contents at: aString ifAbsentPut: aBlock +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: aString put: aBinding + contents at: aString put: aBinding +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +define: aString as: aBinding + contents at: aString put: aBinding +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +defines: identifier + ^contents includesKey: identifier +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +do: aBlock + contents do: aBlock +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +select: aBlock + ^contents select: aBlock +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +values + ^contents values +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +withIndexDo: aBlock + contents withIndexDo: aBlock +! ! + +!StaticBinder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + contents := OrderedDictionary new +! ! + +!StaticBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream indent: anInteger + aStream tab: anInteger; nextPut: $<. + contents keys + do: [:name | name printOn: aStream] + separatedBy: [aStream space]. + aStream nextPut: $> +! ! + +!LocalEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInlinedArgument + ^false +! ! + +!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureType + ^CaptureEnvironmentValue +! ! + +!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^index +! ! + +!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: anInteger + index := anInteger +! ! + +!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCurrent + ^index isNil +! ! + +!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isIndirect + ^self isCurrent not +! ! + +!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isStack + ^false +! ! + +!StackEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^nil +! ! + +!StackEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +isStack + ^true +! ! + +!ArgumentEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureType + ^CaptureLocalArgument +! ! + +!InlinedArgEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +captureType + ^CaptureInlinedArgument +! ! + +!InlinedArgEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isInlinedArgument + ^true +! ! + +!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026 13:27:40'! +inline: aMessageNode + | s keywords | + message := aMessageNode. + message receiver isSuper + ifTrue: [ ^ self ]. + message isCascadeMessage + ifTrue: [ ^ self ]. + s := message selector value. + s == #ifTrue: + ifTrue: [ ^ self inlineConditional ]. + s == #ifFalse: + ifTrue: [ ^ self inlineConditional ]. + s == #or: + ifTrue: [ ^ self inlineConditional ]. + s == #and: + ifTrue: [ ^ self inlineConditional ]. + s == #timesRepeat: + ifTrue: [ ^ self inlineConditional ]. + s == #ifTrue:ifFalse: + ifTrue: [ ^ self inlineConditional ]. + s == #ifFalse:ifTrue: + ifTrue: [ ^ self inlineConditional ]. + s == #andNot: + ifTrue: [ ^ self inlineConditional ]. + s == #orNot: + ifTrue: [ ^ self inlineConditional ]. + s == #ifNil: + ifTrue: [ ^ self inlineConditional ]. + s == #ifNotNil: + ifTrue: [ ^ self inlineIfNotNil ]. + s == #ifNil:ifNotNil: + ifTrue: [ ^ self inlineIfNilIfNotNil ]. + s == #ifNotNil:ifNil: + ifTrue: [ ^ self inlineIfNotNilIfNil ]. + s == #whileTrue: + ifTrue: [ ^ self inlineWhile ]. + s == #whileFalse: + ifTrue: [ ^ self inlineWhile ]. + s == #whileTrue + ifTrue: [ ^ self inlineUnitaryWhile ]. + s == #whileFalse + ifTrue: [ ^ self inlineUnitaryWhile ]. + s == #repeat + ifTrue: [ ^ self inlineRepeat ]. + s == #to:do: + ifTrue: [ ^ self inlineToDo ]. + "s == #to:by:do: + ifTrue: [ ^ self inlineToByDo ]." + keywords := $: split: s. + keywords last = '' + ifTrue: [ keywords := keywords allButLast ]. + (keywords conform: [ :k | k = 'and' ]) + ifTrue: [ ^ self inlineConditional ]. + (keywords conform: [ :k | k = 'or' ]) + ifTrue: [ ^ self inlineConditional ]. + ((keywords allButLast conform: [ :k | k = 'and' ]) + and: [ #('ifTrue' 'ifFalse') includes: keywords last ]) + ifTrue: [ ^ self inlineConditional ]. + ((keywords allButLast conform: [ :k | k = 'or' ]) + and: [ #('ifTrue' 'ifFalse') includes: keywords last ]) + ifTrue: [ self inlineConditional ] +! ! + +!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineRepeat + | receiver arguments | + receiver := message receiver. + receiver isEvaluable + ifFalse: [ ^ self ]. + arguments := message arguments. + arguments isEmpty + ifFalse: [ ^ self ]. + receiver isBlockNode + ifFalse: [ ^ self ]. + message beInlined. + receiver beInlined +! ! + +!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineUnitaryWhile + | receiver arguments | + receiver := message receiver. + receiver isEvaluable ifFalse: [^self]. + arguments := message arguments. + arguments size = 0 ifFalse: [^self]. + self inlineConditional. + receiver isBlockNode ifTrue: [ + message beInlined. + receiver beInlined] +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineConditional + | arguments | + arguments := message arguments. + arguments size >= 1 ifFalse: [^self]. + arguments do: [:arg | arg isEvaluable ifFalse: [^self]]. + message beInlined. + arguments select: #isBlockNode thenDo: #beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineIfNilIfNotNil + | arguments arg | + arguments := message arguments. + arguments size = 2 ifFalse: [^self]. + arguments first isEvaluable ifFalse: [^self]. + arg := arguments second. + (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) + ifFalse: [^self]. + message beInlined. + arguments select: #isBlockNode thenDo: #beInlined + +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineIfNotNil + | arguments arg | + arguments := message arguments. + arguments size = 1 ifFalse: [^self]. + arg := arguments first. + (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) + ifFalse: [^self]. + message beInlined. + arg isBlockNode ifTrue: [arg beInlined] +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineIfNotNilIfNil + | arguments arg | + arguments := message arguments. + arguments size = 2 ifFalse: [^self]. + arguments second isEvaluable ifFalse: [^self]. + arg := arguments first. + (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) + ifFalse: [^self]. + message beInlined. + arguments select: #isBlockNode thenDo: #beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineToByDo + | arguments arg step | + arguments := message arguments. + arguments size = 3 ifFalse: [^self]. + arg := arguments at: 3. + arg isBlockNode ifFalse: [^self]. + arg arguments size = 1 ifFalse: [^self]. + step := arguments at: 2. + (step isNumberNode and: [step value isSmallInteger]) ifFalse: [^self]. + message beInlined. + arg beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineToDo + | arguments last | + arguments := message arguments. + arguments size = 2 ifFalse: [^self]. + last := arguments at: 2. + last isBlockNode ifFalse: [^self]. + last arguments size = 1 ifFalse: [^self]. + message beInlined. + last beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! +inlineWhile + | receiver arguments | + receiver := message receiver. + receiver isEvaluable + ifFalse: [ ^ self ]. + arguments := message arguments. + arguments size = 1 + ifFalse: [ ^ self ]. + arguments last isNullary + ifFalse: [ ^ self ]. + self inlineConditional. + receiver isBlockNode + ifTrue: [ receiver beInlined ] +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +ast + ^ast +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +ast: aParseNode + ast := aParseNode +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +method + ^method +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +method: aCompiledMethod + method := aCompiledMethod +! ! + +!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +beSuccessful + error := nil +! ! + +!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error + ^error +! ! + +!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aCompilationError + error := aCompilationError +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canBeInIdentifier: aCharacter + ^aCharacter isLetter or: [aCharacter isDigit] or: [aCharacter = $_] +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canStartIdentifier: aCharacter + ^aCharacter isLetter or: [aCharacter = $_] +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +peekForIdentifier: aStream + | char next | + char := aStream peek. + (self canBeInIdentifier: char) ifTrue: [ + aStream skip: 1. + ^true]. + char = $. ifFalse: [^false]. + aStream prev isLetter ifFalse: [ + aStream skip: 1. + ^false]. + next := aStream skip: 2; peek. + next isNil ifTrue: [ + aStream skip: -1. + ^false]. + ^next isLetter ifFalse: [aStream skip: -1]; yourself +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +protect: aBlock + ^aBlock value +! ! + +!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +classBinding + ^class +! ! + +!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +classBinding: aSpecies + | instance | + class := aSpecies. + instance := aSpecies instanceClass. + (instance respondsTo: #configureCompiler) + ifTrue: [instance configureCompiler: self] +! ! + +!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize: aDictionary + class := aDictionary at: #UndefinedObject ifAbsent: nil +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +compile: aString + result := self smalltalkCompiler compileMethod: aString. + ^result method +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parse: aString + result := self smalltalkCompiler parseMethod: aString. + ^result ast +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +smalltalkCompiler + ^ SSmalltalkCompiler new frontend: self +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +smalltalkParser + ^ self smalltalkCompiler parser +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +smalltalkScanner + ^ self smalltalkCompiler scanner +! ! + +!SCompiler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +forClass: aClass + | c | + c := aClass ifNil: [UndefinedObject]. + self classBinding: c +! ! + +!SCompiler class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +compile: aString in: aClass + | compiler | + compiler := self forClass: aClass. + ^compiler compile: aString +! ! + +!SCompiler class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parse: aString in: aClass + | compiler | + compiler := self forClass: aClass. + ^compiler parse: aString +! ! + +!SCompiler class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +forClass: aClass + ^self new forClass: aClass +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visit: aParseNode + ^aParseNode notNil ifTrue: [aParseNode acceptVisitor: self] +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitAssignment: anAssignmentNode + ^self visitParseNode: anAssignmentNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBlock: aBlockNode + ^self visitParseNode: aBlockNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBraceNode: aBraceNode + ^self visitParseNode: aBraceNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascade: aCascadeNode + ^self visitParseNode: aCascadeNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascadeMessage: aCascadeMessageNode + ^self visitMessage: aCascadeMessageNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitForeignNode: anForeignNode + self visitLiteral: anForeignNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitIdentifier: anIdentifierNode + ^self visitParseNode: anIdentifierNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitLiteral: aLiteralNode + ^self visitParseNode: aLiteralNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMessage: aMessageNode + ^self visitParseNode: aMessageNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMethod: aMethodNode + ^self visitParseNode: aMethodNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitNumberNode: aNumberNode + ^self visitLiteral: aNumberNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitParseNode: aParseNode + ^self subclassResponsibility +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitPragma: aPragmaNode + ^self visitParseNode: aPragmaNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitReturn: aReturnNode + ^self visitParseNode: aReturnNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitSelector: aSelectorNode + ^self visitParseNode: aSelectorNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitString: aStringNode + ^self visitLiteral: aStringNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitSymbolicPragma: aPragmaNode + ^self visitPragma: aPragmaNode +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeAssignment: anAssignmentNode + anAssignmentNode assignees + do: [:v | self analyzeIdentifier: v assignee: true] +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeBlock: aBlockNode while: aBlock + aBlockNode isInlined + ifFalse: [aBlockNode index: aBlockNode compiler blockIndex]. + self analyzeScript: aBlockNode while: aBlock +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeIdentifier: anIdentifierNode + self analyzeIdentifier: anIdentifierNode assignee: false +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeIdentifier: anIdentifierNode assignee: aBoolean + | script binding | + anIdentifierNode resolveAssigning: aBoolean. + aBoolean ifTrue: [anIdentifierNode beAssigned]. + script := anIdentifierNode compiler activeScript. + binding := anIdentifierNode binding. + script reference: binding. + binding isLocal ifTrue: [binding := script scope captureLocal: binding]. + anIdentifierNode binding: binding +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeMessage: aMessageNode + inliner inline: aMessageNode. + aMessageNode isInlined ifFalse: [aMessageNode compiler noticeSend] +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeMethod: aMethodNode while: aBlock + self analyzeScript: aMethodNode while: aBlock +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeReturn: aReturnNode + aReturnNode compiler activeScript realScript captureHome +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! +analyzeScript: aScriptNode while: aBlock + aScriptNode compiler activate: aScriptNode while: aBlock +! ! + +!SSemanticVisitor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + inliner := MessageInliner new +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitAssignment: anAssignmentNode + self analyzeAssignment: anAssignmentNode. + anAssignmentNode expression acceptVisitor: self +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBlock: aBlockNode + self + analyzeBlock: aBlockNode + while: [aBlockNode statements do: [:node | node acceptVisitor: self]] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBraceNode: aBraceNode + aBraceNode isLiteral + ifFalse: [aBraceNode asMessageNode acceptVisitor: self] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascade: aCascadeNode + aCascadeNode receiver acceptVisitor: self. + aCascadeNode messages do: [:msg | msg acceptVisitor: self] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitIdentifier: anIdentifierNode + self analyzeIdentifier: anIdentifierNode +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMessage: aMessageNode + self analyzeMessage: aMessageNode. + aMessageNode receiver acceptVisitor: self. + aMessageNode arguments do: [:arg | arg acceptVisitor: self] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMethod: aMethodNode + self analyzeMethod: aMethodNode while: [ + aMethodNode bindLocals. + aMethodNode statements do: [:s | s acceptVisitor: self]. + aMethodNode positionLocals] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitParseNode: aParseNode + " + do nothing + " + +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitReturn: aReturnNode + aReturnNode expression acceptVisitor: self. + self analyzeReturn: aReturnNode +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiledBlockIndexOf: aBlockNode + | index | + index := method + findFirst: [:literal | literal isBlock + and: [literal blockNumber == aBlockNode index]]. + ^index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeArgument: anInteger env: environment + | encoded | + encoded := self encodedEnvironment: environment. + self + nextPut: ArgumentId; + nextIntegerPut: anInteger; + nextIntegerPut: encoded +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeClosureElements: aBlockNode + | scope parent | + scope := aBlockNode scope. + parent := aBlockNode realParent. + ^Array streamContents: [:s | + scope capturesSelf ifTrue: [ s nextPut: CaptureSelf ]. + scope capturedEnvironments do: [:e | | index | + e == parent ifTrue: [s nextPut: CaptureEnvironment] ifFalse: [ + index := aBlockNode environmentIndexOf: e. + self ASSERT: index notNil. + s nextPut: CaptureEnvironmentValue; nextPut: index]]. + scope capturedArguments do: [:a | | binding | + binding := aBlockNode parent scope resolve: a name. + s nextPut: binding environmentCaptureType; nextPut: binding index]] + +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeDynamicVar: name + stream nextPut: DynamicVarId. + self nextSymbolPut: name +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeFalse + stream nextPut: FalseId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeLoadRvisitingReceiver + stream nextPut: LoadRvisitingReceiverId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeNestedDynamicVar: name + stream nextPut: NestedDynamicVarId. + self nextLiteralPut: name +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeNil + stream nextPut: NilId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodePopR + stream nextPut: PopRid +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodePushR + stream nextPut: PushRid +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeSelf + stream nextPut: SelfId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeSuper + stream nextPut: SuperId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeTemporary: anInteger env: environment + | encoded | + encoded := self encodedEnvironment: environment. + self + nextPut: TemporaryId; + nextIntegerPut: anInteger; + nextIntegerPut: encoded +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeTrue + stream nextPut: TrueId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodedEnvironment: aLocalEnvironment + aLocalEnvironment isStack + ifTrue: [ ^ aLocalEnvironment isInlinedArgument + ifTrue: [ -1 ] + ifFalse: [ -2 ] ]. + aLocalEnvironment isCurrent + ifTrue: [ ^ 0 ]. + ^ aLocalEnvironment index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBigIntegerPut: anInteger + stream + nextPut: 16r80; + nextInt64Put: anInteger +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBooleanPut: aBoolean + stream nextPut: aBoolean asParameter + +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextIntegerPut: anInteger + | value | + (anInteger > 127 or: [ anInteger < -127 ]) + ifTrue: [ ^ self nextBigIntegerPut: anInteger ]. + value := anInteger >= 0 + ifTrue: [ anInteger ] + ifFalse: [ anInteger + 16r100 ]. + stream nextPut: value +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextLiteralPut: anObject + | index | + index := method + indexOf: anObject + ifAbsent: [ self ASSERT: false ]. + self nextIntegerPut: index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextPut: anInteger + stream nextPut: anInteger +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextPutAll: aCollection + stream nextPut: aCollection size; nextPutAll: aCollection +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextSymbolPut: aSymbol + | index | + index := method + indexOf: aSymbol asSymbol + ifAbsent: [ self ASSERT: false ]. + self nextIntegerPut: index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextTypePut: anInteger + stream nextPut: anInteger +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitAssignment: anAssignmentNode + | assignees | + self nextTypePut: AssignmentId. + assignees := anAssignmentNode assignees. + self nextIntegerPut: assignees size. + assignees do: [ :node | node acceptVisitor: self ]. + anAssignmentNode expression acceptVisitor: self +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBlock: aBlockNode + | args inlined | + self nextTypePut: BlockId. + inlined := aBlockNode isInlined. + self nextBooleanPut: inlined. + inlined + ifTrue: [ args := aBlockNode arguments collect: [ :id | id binding index ]. + self nextPutAll: args asArray ] + ifFalse: [ | index captured | + index := self compiledBlockIndexOf: aBlockNode. + self nextPut: index. + captured := self encodeClosureElements: aBlockNode. + self nextPutAll: captured ]. + self visitScript: aBlockNode +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitBraceNode: aBraceNode + aBraceNode isLiteral + ifTrue: [self visitLiteral: aBraceNode asLiteralNode] + ifFalse: [self visitCascade: aBraceNode asMessageNode] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascade: aCascadeNode + | messages | + self nextTypePut: CascadeId. + aCascadeNode receiver acceptVisitor: self. + messages := aCascadeNode messages. + self nextIntegerPut: messages size. + messages do: [ :node | self visitCascadeMessage: node ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitCascadeMessage: aCascadeMessageNode + | arguments | + self nextSymbolPut: aCascadeMessageNode selector symbol. + arguments := aCascadeMessageNode arguments. + self nextIntegerPut: arguments size. + arguments do: [ :arg | arg acceptVisitor: self ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitIdentifier: anIdentifierNode + self nextTypePut: IdentifierId. + anIdentifierNode binding encodeUsing: self +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitLiteral: aLiteralNode + | index | + index := method indexOf: aLiteralNode value. + self + nextTypePut: LiteralId; + nextIntegerPut: index. + index = 0 + ifTrue: [ self nextIntegerPut: aLiteralNode value ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMessage: aMessageNode + | arguments | + self + nextTypePut: MessageId; + nextBooleanPut: aMessageNode isInlined; + nextSymbolPut: aMessageNode selector symbol. + aMessageNode receiver acceptVisitor: self. + arguments := aMessageNode arguments. + self nextIntegerPut: arguments size. + arguments do: [ :arg | arg acceptVisitor: self ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitMethod: aMethodNode + | pragma | + self nextTypePut: MethodId. + pragma := aMethodNode pragma. + pragma isUsed + ifTrue: [ self nextTypePut: PragmaId. + pragma name + ifNotNil: [ self nextSymbolPut: pragma name ] + ifNil: [ self nextPut: 0 ] ]. + self visitScript: aMethodNode. + ^ stream contents +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitParseNode: aParseNode + ^self ASSERT: false +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitReturn: aReturnNode + self + nextTypePut: ReturnId; + nextBooleanPut: script realScript isMethod. + + aReturnNode expression acceptVisitor: self +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +visitScript: aScriptNode + | prev statements | + prev := script. + script := aScriptNode. + statements := aScriptNode statements. + self nextIntegerPut: statements size. + statements do: [ :node | node acceptVisitor: self ]. + script := prev +! ! + +!TreecodeEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + stream := #[] writeStream +! ! + +!TreecodeEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +method: aCompiledMethod + method := aCompiledMethod +! ! + +!TreecodeEncoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeBindingIds + | named | + named := self addNamespaceAs: #BindingIds. + named + at: #NilId put: 1; + at: #TrueId put: 2; + at: #FalseId put: 3; + at: #ArgumentId put: 4; + at: #TemporaryId put: 5; + at: #SelfId put: 6; + at: #SuperId put: 7; + at: #DynamicVarId put: 14; + at: #NestedDynamicVarId put: 15; + at: #PushRid put: 50; + at: #PopRid put: 51 +! ! + +!TreecodeEncoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeTreecodeIds + | named | + named := self addNamespaceAs: #TreecodeIds. + named + at: #MethodId put: 101; + at: #BlockId put: 102; + at: #IdentifierId put: 103; + at: #LiteralId put: 104; + at: #MessageId put: 105; + at: #CascadeId put: 106; + at: #BraceId put: 107; + at: #AssignmentId put: 108; + at: #ReturnId put: 109; + at: #PragmaId put: 110 +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +capturesSelf + ^ captureSelf +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +describe: identifier + | binding type | + binding := self resolve: identifier. + type := self class name asLowercase allButLast: 'scope' size. + ^binding description , ' of ' , type +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentSize + ^envSize +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +scopeOf: aString + | s | + s := self scriptDefining: aString. + ^s notNil ifTrue: [s scope] +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +stackSize + ^stackSize +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +defineArgument: identifier + | binding | + (self resolves: identifier) ifTrue: [self redefinitionError: identifier]. + binding := ArgumentBinding new name: identifier. + arguments define: identifier as: binding. + ^binding +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +defineTemporary: identifier + | binding | + (temporaries defines: identifier) + ifTrue: [self redefinitionError: identifier]. + binding := TemporaryBinding new name: identifier. + temporaries define: identifier as: binding. + ^binding +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +defines: aString + ^(temporaries defines: aString) or: [arguments defines: aString] +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +localBindings + ^arguments values , temporaries values +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolveLocal: aString + (temporaries at: aString) ifNotNil: [:binding | ^binding]. + ^arguments at: aString +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolves: aString + ^(self resolve: aString) isDynamic not +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +growEnvironment + ^envSize := envSize + 1 +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +growStack + ^stackSize := stackSize + 1 +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionDefinedArguments + arguments withIndexDo: [:binding :index | binding index: index] +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionDefinedLocals + self positionDefinedTemporariesIn: self; positionDefinedArguments +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionDefinedTemporariesIn: aScriptScope + temporaries do: [:binding | | position | + position := binding isInStack + ifTrue: [aScriptScope growStack] + ifFalse: [aScriptScope growEnvironment]. + binding index: position] +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionLocals + self positionDefinedLocals +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +realScope + ^script realScript scope +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +redefinitionError: name + | scope description | + scope := self scopeOf: name. + description := scope describe: name. + script compiler + warning: name , ' already declared as ' , description + at: script stretch +! ! + +!ScriptScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + arguments := StaticBinder new. + temporaries := StaticBinder new. + stackSize := envSize := 0. + captureSelf := false. +! ! + +!ScriptScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +script: aScriptNode + script := aScriptNode +! ! + +!ScriptScope class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +on: aScriptNode + ^self new script: aScriptNode +! ! + +!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureArgument: anArgumentBinding + | name | + name := anArgumentBinding name. + ^captured at: name ifAbsentPut: [| transferred copy | + transferred := self parent transferLocal: name. + copy := self copyLocal: transferred. + copy declaration: transferred declaration] +! ! + +!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +localBindings + ^super localBindings , captured values +! ! + +!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolve: aString + (self resolveLocal: aString) ifNotNil: [:binding | ^binding]. + ^self parent resolve: aString +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureEnvironment: aScriptNode + script == aScriptNode ifTrue: [^self]. + (environments includesIdentical: aScriptNode) ifTrue: [^self]. + self realParent captureEnvironment: aScriptNode. + aScriptNode isMethod + ifTrue: [environments addFirst: aScriptNode] + ifFalse: [environments addLast: aScriptNode] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +capturedEnvironmentIndexOf: aScriptNode + | index | + aScriptNode realScript == script realScript + ifTrue: [ ^ nil ]. + index := environments indexOf: aScriptNode ifAbsent: nil. + self ASSERT: index notNil. + ^self capturesSelf ifTrue: [ index + 1 ] ifFalse: [ index ] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +copyLocal: binding + ^script isInlined ifTrue: [binding] ifFalse: [binding copy beInArray] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentIndexOf: aScriptNode + " + temporal compatibility + " + (aScriptNode isKindOf: SScriptNode) + ifFalse: [ self ASSERT: false. ^nil ]. + ^self capturedEnvironmentIndexOf: aScriptNode +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentSizeUpToCapturedArguments + ^self environmentSizeUpToEnvironments + self capturedArguments size +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentSizeUpToEnvironments + | receiver | + receiver := self capturesSelf ifTrue: [ 1 ] ifFalse: [ 0 ]. + ^receiver + environments size +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +parent + ^script parent scope +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionCapturedArgument: anArgumentBinding + anArgumentBinding index: self growEnvironment +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionCapturedLocals + script isInlined ifTrue: [^self]. + envSize := self environmentSizeUpToEnvironments. + captured do: [:binding | + binding isArgument + ifTrue: [self positionCapturedArgument: binding] + ifFalse: [self positionCapturedTemporary: binding]] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionCapturedTemporary: aTemporaryBinding + | outest index declaration | + outest := self scriptDefining: aTemporaryBinding name. + index := self capturedEnvironmentIndexOf: outest realScript. + aTemporaryBinding environmentIndex: index. + declaration := outest scope resolve: aTemporaryBinding name. + self ASSERT: declaration index isInteger. + aTemporaryBinding index: declaration index +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionDefinedArgumentsIn: aScriptScope + arguments do: [:binding | | index | + index := binding isInArray + ifTrue: [aScriptScope growEnvironment] + ifFalse: [aScriptScope growStack]. + binding index: index] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionDefinedLocals + | real | + script isInlined + ifTrue: [ + real := self realScope. + self + positionDefinedTemporariesIn: real; + positionDefinedArgumentsIn: real] + ifFalse: [super positionDefinedLocals] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionLocals + self positionCapturedLocals. + super positionLocals +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +realParent + ^script realParent scope +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +transferLocal: name + | binding copy | + (self resolveLocal: name) ifNotNil: [:b | ^b]. + binding := self parent transferLocal: name. + copy := self copyLocal: binding. + captured at: name put: copy. + ^copy +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureLocal: aLocalBinding + (self defines: aLocalBinding name) ifTrue: [^aLocalBinding]. + ^aLocalBinding isTemporary + ifTrue: [self captureTemporary: aLocalBinding] + ifFalse: [self captureArgument: aLocalBinding] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureSelf + captureSelf ifTrue: [^self]. + captureSelf := true. + self parent captureSelf +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureTemporary: aTemporaryBinding + | name | + name := aTemporaryBinding name. + (self defines: name) ifTrue: [^aTemporaryBinding]. + ^captured at: name ifAbsentPut: [| parent declaration transferred copy | + parent := self parent. + declaration := parent scriptDefining: name. + self realScope captureEnvironment: declaration realScript. + transferred := parent transferLocal: name. + copy := self copyLocal: transferred. + copy isInArray ifTrue: [aTemporaryBinding beInArray]. + copy declaration: transferred declaration] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +capturedArguments + ^captured select: [:b | b isArgument] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +capturedEnvironments + ^environments +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +capturesHome + ^self home notNil +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +environments + " + compatibility, removes the home environment + " + | first | + environments isEmpty ifTrue: [^#()]. + first := environments first. + ^first isMethod ifTrue: [environments allButFirst] ifFalse: [environments] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +home + | first | + environments isEmpty ifTrue: [^nil]. + first := environments first. + ^first isMethod ifTrue: [first] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolveLocal: aString + (super resolveLocal: aString) ifNotNil: [:binding | ^binding]. + ^captured at: aString +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +scriptDefining: aString + (self defines: aString) ifTrue: [^script]. + ^self parent scriptDefining: aString +! ! + +!BlockScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + captured := StaticBinder new. + environments := OrderedCollection new +! ! + +!MethodScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureEnvironment: aScriptNode + self ASSERT: aScriptNode == script +! ! + +!MethodScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +transferLocal: name + ^self resolveLocal: name +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureLocal: aLocalBinding + self ASSERT: (self resolveLocal: aLocalBinding name) notNil. + ^aLocalBinding +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureSelf + captureSelf := true. + +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentIndexOf: aScriptNode + self ASSERT: aScriptNode == script. + ^nil +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolve: aString + (self resolveLocal: aString) ifNotNil: [ :binding | ^ binding ]. + (self resolvePseudo: aString) ifNotNil: [ :binding | ^ binding ]. + ^ DynamicBinding named: aString +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +scriptDefining: aString + (self resolveLocal: aString) ifNotNil: [^script]. + self ASSERT: false. + ^nil +! ! + +!MethodScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + self initializePseudoVars +! ! + +!MethodScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializePseudoVars + pseudo := StaticBinder new. + pseudo + at: 'nil' put: NilBinding new; + at: 'true' put: TrueBinding new; + at: 'false' put: FalseBinding new; + at: 'self' put: SelfBinding new; + at: 'super' put: SuperBinding new +! ! + +!MethodScope methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolvePseudo: aString + ^pseudo at: aString + +! ! + +!Binding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +beReferencedFrom: aScriptNode + +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canBeAssigned + ^true +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +declaration + ^self +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEncoder + self ASSERT: false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isArgument + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isClassBinding + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isClassVariable + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isConstantBinding + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDynamic + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isGlobal + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInStack + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInstVar + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLiteral + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLocal + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isPoolVariableBinding + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSelf + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSelfOrSuper + ^self isSelf or: [self isSuper] +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSuper + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isTemporary + ^false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +literal + ^nil +! ! + +!Binding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^name +! ! + +!Binding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name: aString + name := aString +! ! + +!Binding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printNameOn: aStream + aStream + print: name + +! ! + +!Binding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + self printNameOn: aStream. + aStream + nextPutAll: ' ('. + super printOn: aStream. + aStream nextPutAll: ')' +! ! + +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +beReferencedFrom: aScriptNode + "a dynamic binding could refer to an ivar, so we have to be conservative" + aScriptNode useSelf +! ! + +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeDynamicVar: name +! ! + +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDynamic + ^true +! ! + +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +literal + ^name asSymbol +! ! + +!DynamicBinding class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +default + ^Default ifNil: [Default := self new name: ''] +! ! + +!DynamicBinding class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +named: aString + | index first second | + index := aString indexOf: $.. + index = 0 ifTrue: [ ^self new name: aString ]. + first := aString copyFrom: 1 to: index - 1. + second := aString copyFrom: index + 1 to: aString size. + ^NestedDynamicBinding new name: { first. second } +! ! + +!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeNestedDynamicVar: name +! ! + +!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +literal + ^name collect: [ :n | n asSymbol] +! ! + +!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +printNameOn: aStream + name do: [ :n | aStream nextPutAll: n ] separatedBy: [ aStream nextPut: $. ] +! ! + +!LiteralBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLiteral + ^true +! ! + +!FalseBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeFalse +! ! + +!FalseBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^'false' +! ! + +!FalseBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^false +! ! + +!NilBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeNil +! ! + +!NilBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +name + ^'nil' +! ! + +!NilBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +value + ^nil +! ! + +!TrueBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeTrue +! ! + +!TrueBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^'true' +! ! + +!TrueBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^true +! ! + +!LocalBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +beInArray + environment := ArrayEnvironment new +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +declaration + ^declaration +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +declaration: anIdentifierNode + declaration := anIdentifierNode +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environment + ^environment index +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentCaptureType + ^environment captureType +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentIndex + ^environment index +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentIndex: anInteger + environment index: anInteger +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentObject + ^environment +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^index +! ! + +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: aNumber + index := aNumber +! ! + +!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInArray + ^self isInStack not +! ! + +!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInStack + ^environment isStack +! ! + +!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLocal + ^true +! ! + +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +beInlined + environment := InlinedArgEnvironment new +! ! + +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +description + ^'argument ' , name +! ! + +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEncoder + aTreecodeEncoder encodeArgument: index env: environment +! ! + +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInlined + ^environment isInlinedArgument +! ! + +!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canBeAssigned + ^false +! ! + +!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: aNumber + index := aNumber. + +! ! + +!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isArgument + ^true +! ! + +!ArgumentBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + environment := ArgumentEnvironment new +! ! + +!TemporaryBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +description + ^'temporary ' , name +! ! + +!TemporaryBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEncoder + aTreecodeEncoder encodeTemporary: index env: environment +! ! + +!TemporaryBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + environment := StackEnvironment new +! ! + +!TemporaryBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isTemporary + ^true +! ! + +!SelfBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! +beReferencedFrom: aScriptNode + aScriptNode useSelf +! ! + +!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canBeAssigned + ^false +! ! + +!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeSelf +! ! + +!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSelf + ^true +! ! + +!SelfBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^'self' +! ! + +!SuperBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeSuper +! ! + +!SuperBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^'super' +! ! + +!SuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSelf + ^false +! ! + +!SuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSuper + ^true +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +activate: aScriptNode while: aBlock + | current | + current := activeScript. + activeScript := aScriptNode. + aBlock value. + activeScript := current +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +activeScope + ^activeScript scope +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +activeScript + ^activeScript +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +activeScript: aParseNode + activeScript := aParseNode +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +ast + ^ast +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +frontend + ^frontend +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +frontend: aCompiler + frontend := aCompiler +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parser + ^SSmalltalkParser new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +result + ^result +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +scanner + ^SSmalltalkScanner new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sourceCode + ^source +! ! + +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sourceCode: aString + source := aString +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +assignmentNode + ^SAssignmentNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +blockNode + ^SBlockNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +braceNode + ^SBraceNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildMethod + result method: ast buildMethod +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +cascadeMessageNode + ^SCascadeMessageNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +cascadeNode + ^SCascadeNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +commentNode + ^SCommentNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +compileMethod: aString + source := aString. + frontend protect: [ + self + parseMethod; + resolveSemantics; + buildMethod]. + ^result +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +delimiterToken + ^SDelimiterToken new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +endToken + ^SEndToken new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasBlocks + ^ blocks > 0 +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasSends +^ leaf not +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +identifierNode + ^SIdentifierNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + self reset + +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +literalNode + ^SLiteralNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +messageNode + ^SMessageNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodNode + ^SMethodNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +noticeSend + leaf := false +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +numericLiteralNode + ^SNumberNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +pragmaNode + ^SPragmaNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +reset + self resetResult. + leaf := true. + blocks := 0. +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +returnNode + ^SReturnNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +selectorNode + ^SSelectorNode new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! +stringToken + ^SStringToken new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'emitting' stamp: 'KenD 28/Jun/2026 13:27:40'! +blockCount + ^blocks +! ! + +!SSmalltalkCompiler methodsFor: 'emitting' stamp: 'KenD 28/Jun/2026 13:27:40'! +blockIndex + blocks := blocks + 1. + ^blocks - 1 +! ! + +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +compilationError: aString stretch: aStretch + ^SCompilationError new + compiler: self; + stretch: aStretch; + description: aString +! ! + +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString at: anInteger + | stretch | + stretch := anInteger thru: anInteger. + ^self error: aString stretch: stretch +! ! + +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString stretch: aStretch + | error | + error := self compilationError: aString stretch: aStretch. + ^error beFatal; signal +! ! + +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +warning: aString at: aStretch + | error | + error := self compilationError: aString stretch: aStretch. + error beWarning; signal +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseFragment + headless := false. + self reset. + ast := self parser methodFragment. + result ast: ast +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseFragment: aString + source := aString. + [self parseFragment; resolveSemantics] on: SCompilationError do: []. + ^ast +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseMethod + headless := false. + self reset. + ast := self parser method. + result ast: ast +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseMethod: aString + source := aString. + frontend protect: [self parseMethod; resolveSemantics]. + ^result +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolveSemantics + ast acceptVisitor: SSemanticVisitor new +! ! + +!SSmalltalkCompiler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +resetResult + result := SCompilationResult new compiler: self +! ! + +!SSmalltalkCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +supportsBraceNodes + ^true +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addBodyTo: aMethodNode + self + addTemporariesTo: aMethodNode; + addPragmaTo: aMethodNode; + addStatementsTo: aMethodNode +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addStatementsTo: aMethodNode + aMethodNode + position: token position; + addStatements: self statements; + end: token position; + moveCommentsFrom: token. + token isEnd + ifFalse: [^self unexpectedStatementError: aMethodNode statements] +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +addTemporariesTo: aMethodNode + aMethodNode temporaries: self temporaries +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +cascadeSequence: aMessageNode + | cascade receiver messages msg node | + (token is: $;) ifFalse: [^aMessageNode]. + cascade := self buildNode: compiler cascadeNode at: aMessageNode position. + receiver := aMessageNode receiver. + cascade receiver: receiver. + node := compiler cascadeMessageNode from: aMessageNode. + node cascade: cascade. + messages := OrderedCollection with: node. + [token is: $;] whileTrue: [ + self step. + msg := self buildCascadeMessageNode: receiver. + msg + cascade: cascade; + position: token position; + moveCommentsFrom: token. + messages add: msg. + self cascadeMessage: msg]. + ^cascade messages: messages asArray; end: msg end +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +expression + | primary expression | + (token isNameToken and: [self peek isAssignment]) ifTrue: [^self assignment]. + primary := self primary ifNil: [^self missingExpression]. + expression := self unarySequence: primary. + expression := self binarySequence: expression. + expression := self keywordSequence: expression. + expression == primary + ifFalse: [expression := self cascadeSequence: expression]. + token endsExpression ifFalse: [self errorIn: primary]. + ^expression +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +keywordSignature + | selector arguments node | + selector := '' writeStream. + arguments := OrderedCollection new. + node := self buildNode: compiler selectorNode at: token position. + [token isKeyword] whileTrue: [ + selector nextPutAll: token value. + node addKeyword: token asSelectorNode. + self step. + token isNameToken ifFalse: [self missingArgument]. + arguments add: token asIdentifierNode. + self step]. + arguments isEmpty ifTrue: [^nil]. + node + symbol: selector contents; + end: token end; + moveCommentsFrom: token. + ^self buildMethodNode: node arguments: arguments +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodPragma + self step. + ^[| method | + method := self methodSignature. + self addTemporariesTo: method; attachPragmaTo: method. + method pragma] + on: SCompilationError + do: [:ex | ex return: compiler pragmaNode] +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodSignature + self keywordSignature ifNotNil: [:m | ^m]. + self binarySignature ifNotNil: [:m | ^m]. + self unarySignature ifNotNil: [:m | ^m]. + self error: 'method signature expected' +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parenthesizedExpression + | start open expression | + start := token position. + open := self step. + expression := self expression. + expression moveCommentsFrom: open. + (token is: $)) ifFalse: [self missingToken: ')']. + expression isImmediate + ifFalse: [expression position: start; end: token position]. + self step. + ^expression +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +primary + token isNameToken ifTrue: [^self step asIdentifierNode]. + token isLiteral ifTrue: [^self step]. + (token is: $[) ifTrue: [^self block]. + (token is: $() ifTrue: [^self parenthesizedExpression]. + (token is: #'#(') ifTrue: [^self literalArray]. + (token is: #'#[') ifTrue: [^self literalByteArray]. + (compiler supportsBraceNodes and: [token is: ${]) ifTrue: [^self bracedArray]. + (token is: #'-') ifTrue: [^self negativeNumber]. + (token is: #'<') ifTrue: [^self taggedNode]. + ^nil +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +return + | return expression end node | + return := self step. + expression := self expression. + expression moveCommentsFrom: token. + end := token position. + self skipDots. + node := self buildNode: compiler returnNode at: return position. + ^node + return: return; + end: end; + expression: expression; + moveCommentsFrom: return +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +statement + | expression | + ((token is: $^) or: [token is: $↑]) ifTrue: [^self return]. + expression := self expression. + token moveCommentsTo: expression. + ^expression +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +statements + | statements | + statements := OrderedCollection new. + [ + token endsExpression ifTrue: [^statements]. + statements add: self statement. + token is: $.] + whileTrue: [self skipDots]. + ^statements +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +step + | save comments | + save := token. + self next isComment ifFalse: [^save]. + comments := OrderedCollection new: 2. + [ + comments add: token. + self next isComment] whileTrue. + token comments: comments. + ^save +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaries + | temporaries | + (token is: #'||') ifTrue: [ + self step. + ^#()]. + token isBar ifFalse: [^#()]. + temporaries := OrderedCollection new. + [ + self step. + token isNameToken] + whileTrue: [ + self validateLocalName: token. + temporaries add: token asIdentifierNode]. + token isBar ifFalse: [self missingToken: '|']. + self step. + ^temporaries +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +unaryMessage: aMessageNode + | selector | + selector := self unarySelector. + aMessageNode + selector: selector; + end: selector end; + arguments: #(); + moveCommentsFrom: selector +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +unarySelector + | selector start end node | + selector := token value. + start := token position. + end := start + selector size - 1. + self step. + node := self buildNode: compiler selectorNode at: start. + ^node + symbol: selector; + end: end; + moveCommentsFrom: token +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +unarySequence: aParseNode + | node receiver | + node := aParseNode. + node isNameToken ifTrue: [node := node asIdentifierNode]. + [ + receiver := node. + self hasUnarySelector] + whileTrue: [ + node := self buildMessageNode: receiver. + self unaryMessage: node]. + ^node moveCommentsFrom: token +! ! + +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +unarySignature + self hasUnarySelector ifFalse: [^nil]. + ^self buildMethodNode: self unarySelector arguments: #() +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +addByteTo: aCollection + | byte | + byte := token isLiteral ifTrue: [token value] ifFalse: [token literalValue]. + byte isInteger ifFalse: [self nonIntegerToken]. + (byte between: 0 and: 255) ifFalse: [self invalidByteValue]. + aCollection add: byte +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +assignment + | position variable delimiter expression assignment | + position := token position. + variable := self step asIdentifierNode moveCommentsFrom: token. + delimiter := self step. + expression := self expression. + expression isAssign + ifTrue: [^expression assign: variable operator: delimiter]. + expression moveCommentsFrom: token. + assignment := self buildNode: compiler assignmentNode at: position. + ^assignment assign: variable with: expression operator: delimiter +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +attachPragmaTo: aMethodNode + | start pragma | + (aMethodNode isHeadless orNot: [token is: #'<']) ifTrue: [^false]. + start := token position. + self step. + pragma := token isKeyword + ifTrue: [self ffiOrPrimitive: aMethodNode] + ifFalse: [self symbolicPragma]. + pragma position: start; end: token position. + aMethodNode pragma: pragma. + (token is: #'>') ifFalse: [self missingToken: '>']. + ^true +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildBraceNode: elements at: position + | node | + node := self buildNode: compiler braceNode at: position. + ^node elements: elements +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildCascadeMessageNode: receiver + | node | + node := self buildNode: compiler cascadeMessageNode at: receiver position. + ^node receiver: receiver +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildMessageNode: receiver + | node | + node := self buildNode: compiler messageNode at: receiver position. + ^node receiver: receiver +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildMethodNode: selector arguments: arguments + | node | + node := self buildNode: compiler methodNode at: selector position. + compiler activeScript: node. + ^node selector: selector; arguments: arguments +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildNode: aParserNode at: anInteger + ^aParserNode position: anInteger; end: token position +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildNode: aParseNode at: anInteger with: anObject + | node | + node := scanner buildToken: aParseNode at: anInteger with: anObject. + ^node end: token position +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +cascadeMessage: aMessageNode + | msg | + self hasUnarySelector ifTrue: [^self unaryMessage: aMessageNode]. + self hasBinarySelector ifTrue: [^self binaryMessage: aMessageNode]. + self hasKeywordSelector ifTrue: [^self keywordMessage: aMessageNode]. + msg := token value = '' + ifTrue: ['unfinished cascade'] + ifFalse: [token value asString , ' not allowed in cascade']. + self error: msg +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffiArguments + | args type | + args := OrderedCollection new. + self step. + token value !!= $( + ifTrue: [ self error: 'expected "("' ]. + self peek value = $) + ifTrue: [ self step. + ^ args ]. + [ type := self ffiType. + args add: type. + self step. + token value = #, ] whileTrue. + token value !!= $) + ifTrue: [ self error: 'expected ")"' ]. + ^ args +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffiCall: aBoolean method: aMethodNode + | cc return name args descriptor | + cc := token value. + return := self ffiType. + aBoolean + ifTrue: [ self step. + name := token value ifNil: [ self error: 'invalid function name' ] ]. + args := self ffiArguments. + args size = aMethodNode selector arity + ifFalse: + [ ^ self error: 'method arity does not match with function arguments' ]. + self step. + descriptor := SFFIDescriptor ret: return args: args cc: cc. + ^ compiler pragmaNode ffi: cc name: name with: descriptor +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffiOrPrimitive: aMethodNode + | tag | + tag := token value asLowercase. + tag last = $: ifFalse: [self invalidPragma]. + tag := tag allButLast. + token value: tag. + tag = 'primitive' ifTrue: [^self primitive]. + tag = 'callback' ifTrue: [ ^self ffiCall: false method: aMethodNode ]. + tag = 'callout' ifTrue: [ ^self ffiCall: true method: aMethodNode ]. + self invalidPragma +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffiType + | type | + self step. + token isNameToken ifFalse: [self error: 'expected type name']. + type := token value. + type = 'struct' ifFalse: [ ^type]. + self step. + token isNameToken ifFalse: [self error: 'expected type name']. + ^token value +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasKeywordSelector + ^token isKeyword +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasUnarySelector + ^token isNameToken +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +invalidPragma + | position stretch | + position := token position. + stretch := position thru: position. + ^SInvalidPragmaError new stretch: stretch; signal +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +keywordArgument + | arg | + arg := self primary ifNil: [self missingArgument]. + arg := self unarySequence: arg. + ^self binarySequence: arg +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +keywordMessage: aMessageNode + | selector arguments node | + node := self buildNode: compiler selectorNode at: token position. + selector := '' writeStream. + arguments := OrderedCollection new. + [token isKeyword] whileTrue: [ + selector nextPutAll: token value. + node addKeyword: self step. + arguments add: self keywordArgument]. + node symbol: selector contents; end: token prevPosition. + aMessageNode + arguments: arguments; + end: token prevPosition; + selector: node +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +keywordSequence: aParseNode + | expression | + self hasKeywordSelector ifFalse: [^aParseNode]. + expression := self buildMessageNode: aParseNode. + self keywordMessage: expression. + ^expression +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +literalKeyword + | keyword | + keyword := token value , scanner nextKeyword value. + ^keyword reduced asSymbol +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +namedPrimitive + | name pragma | + token isNameToken + ifFalse: [ self invalidPragma ]. + name := token value. + pragma := self buildNode: compiler pragmaNode at: token position. + ^ pragma primitive: 0 name: name asSymbol +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +negativeNumber + token := nil. + ^self negativeNumberOrBinary; step +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +numberedPrimitive + | number pragma | + number := token value. + number isInteger ifFalse: [self invalidPragma]. + pragma := self buildNode: compiler pragmaNode at: token position. + ^pragma primitive: number name: nil +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +primitive + | primitive | + self step. + primitive := token isNumberNode + ifTrue: [self numberedPrimitive] + ifFalse: [self namedPrimitive]. + self step. + ^primitive +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +pseudoLiteralValue + | value | + token isPoolLiteral ifTrue: [^token literalValue]. + value := token value. + value = 'nil' ifTrue: [^nil]. + value = 'true' ifTrue: [^true]. + value = 'false' ifTrue: [^false]. + ^token isPoolLiteral ifTrue: [token literalValue] ifFalse: [value asSymbol] +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipDots + [token is: $.] whileTrue: [self step] +! ! + +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +validateLocalName: aSmalltalkToken + aSmalltalkToken isDelimitedIdentifier ifTrue: [^self]. + (aSmalltalkToken value includes: $.) + ifTrue: [self error: 'invalid embedded dot'] +! ! + +!SSmalltalkParser methodsFor: 'api support' stamp: 'KenD 28/Jun/2026 13:27:40'! +addPragmaTo: aMethodNode + (self attachPragmaTo: aMethodNode) ifTrue: [self step] +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +arrayBody + | literals position | + literals := OrderedCollection new. + position := token position. + [ + self step. + (token is: $)) or: [token isEnd]] + whileFalse: [| element | + element := self arrayElement. + literals add: element]. + token isEnd ifTrue: [self missingToken: ')']. + ^self buildNode: compiler literalNode at: position with: literals asArray +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +arrayElement + token isLiteral ifTrue: [^token value]. + token isNameToken ifTrue: [^self pseudoLiteralValue]. + token isKeyword ifTrue: [^self literalKeyword]. + (token is: #'-') ifTrue: [^self negativeNumberOrBinary]. + token hasSymbol ifTrue: [^token value]. + (token is: $() ifTrue: [^self arrayBody value]. + (token is: #'#(') ifTrue: [^self arrayBody value]. + (token is: #'#[') ifTrue: [^self byteArrayBody value]. + self invalidArrayToken +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +braceBody + | elements position | + elements := OrderedCollection new. + position := token position. + self step. + [ + token isEnd ifTrue: [self missingToken: '}']. + token is: $}] + whileFalse: [ + elements add: self expression. + (token is: $.) ifTrue: [self step]]. + ^self buildBraceNode: elements at: position +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +bracedArray + | array | + array := self braceBody. + self step. + ^array +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +byteArrayBody + | bytes save start array node | + bytes := OrderedCollection new. + save := token. + start := token position. + [ + self step. + token isLiteral or: [token isPoolLiteral]] + whileTrue: [self addByteTo: bytes]. + (token is: $]) ifFalse: [ + token isNameToken + ifTrue: [self missingLiteral] + ifFalse: [self missingToken: ']']]. + array := ByteArray new: bytes size. + bytes withIndexDo: [:b :i | array at: i put: b]. + node := self buildNode: compiler literalNode at: start with: array. + ^node moveCommentsFrom: save +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +literalArray + | array | + array := self arrayBody. + self step. + ^array +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +literalByteArray + | node | + node := self byteArrayBody. + self step. + ^node +! ! + +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! +negativeNumberOrBinary + self peek isNumberNode + ifTrue: [token := self next negate position: token position - 1]. + ^token value +! ! + +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! +binaryMessage: aMessageNode + | selector primary argument | + selector := self step. + primary := self primary. + primary isNil ifTrue: [ + ((selector is: $:) and: [token is: #'=']) + ifTrue: [self + error: 'stray whitespaces left in assignment' + at: token position - 1] + ifFalse: [self error: 'primary missing']]. + argument := self unarySequence: primary. + aMessageNode + selector: selector asSelectorNode; + end: argument end; + arguments: {argument} +! ! + +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! +binarySequence: aParseNode + | node rcvr | + node := aParseNode. + [ + rcvr := node. + self hasBinarySelector] + whileTrue: [ + node := self buildMessageNode: rcvr. + self binaryMessage: node]. + ^node +! ! + +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! +binarySignature + | selector arguments | + ((token isStringToken and: [token hasSymbol]) + or: [token is: $^] + or: [token is: $:]) + ifFalse: [^nil]. + selector := self step asSelectorNode. + token isNameToken ifFalse: [self missingArgument]. + self validateLocalName: token. + arguments := {token asIdentifierNode}. + self step. + token moveCommentsTo: selector. + ^self buildMethodNode: selector arguments: arguments +! ! + +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasBinarySelector + ^(token isStringToken and: [token hasSymbol]) + or: [token is: $^] + or: [token is: $:] +! ! + +!SSmalltalkParser methodsFor: 'blocks' stamp: 'KenD 28/Jun/2026 13:27:40'! +block + | block | + block := self buildNode: compiler blockNode at: token position. + block parent: compiler activeScript. + compiler activate: block while: [ + token moveCommentsTo: block. + self step. + block + arguments: self blockArguments; + temporaries: self temporaries; + addStatements: self statements. + (token is: $]) ifFalse: [self missingToken: ']']. + block end: token position. + token moveCommentsTo: block. + self step]. + ^block +! ! + +!SSmalltalkParser methodsFor: 'blocks' stamp: 'KenD 28/Jun/2026 13:27:40'! +blockArguments + | arguments | + (token is: $:) ifFalse: [^#()]. + arguments := OrderedCollection new. + [ + self step. + token isNameToken ifFalse: [self missingArgument]. + self validateLocalName: token. + arguments add: self step asIdentifierNode. + token is: $:] whileTrue. + token isBar ifTrue: [self step] ifFalse: [ + (token is: #'||') + ifTrue: [token value: #'|'] + ifFalse: [self missingToken: '|']]. + ^arguments +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler + ^compiler +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler. + scanner := compiler scanner +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +next + token := next. + next := nil. + ^token ifNil: [token := scanner next] +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +on: aString + scanner on: aString +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +peek + | comments | + next ifNotNil: [^next]. + next := scanner next. + next isComment ifFalse: [^next]. + comments := OrderedCollection new: 2. + [ + comments add: next. + next := scanner next. + next isComment] whileTrue. + ^next comments: comments +! ! + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +token + ^token +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString + self error: aString at: token position +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString at: position + ^compiler error: aString at: position +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +invalidArrayToken + self error: 'invalid literal entry' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +invalidByteValue + self error: 'value not between 0 and 255' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +missingArgument + self error: 'argument missing' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +missingExpression + self error: 'missing expression' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +missingLiteral + self error: 'missing literal or named literal' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +missingToken: aString + self error: 'missing ' , aString +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +nonIntegerToken + self error: 'non-integer token' +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +notify: aString + compiler notify: aString at: token position +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +notify: aString at: position + compiler notify: aString at: position +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +warning: aString + compiler warning: aString at: token position +! ! + +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +warning: aString at: position + compiler warning: aString at: position +! ! + +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! +headlessMethod + | method | + self step. + method := compiler methodNode. + compiler activeScript: method. + self addBodyTo: method. + ^method +! ! + +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! +method + | method | + self step. + method := self methodSignature. + method isNil ifTrue: [^nil]. + self addBodyTo: method. + ^method +! ! + +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodFragment + | method | + self step. + method := self methodSignature. + method isNil ifTrue: [^nil]. + [self addBodyTo: method] on: SCompilationError do: []. + ^method +! ! + +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! +methodSelector + self step. + ^self methodSignature ifNotNil: [:m | m selectorNode] +! ! + +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parse: aString + ^self on: aString; method +! ! + +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseExpression: aString + ^self on: aString; headlessMethod +! ! + +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseFragment: aString + | method | + self on: aString; step. + [ + method := self methodSignature. + method notNil ifTrue: [self addBodyTo: method]] + on: SCompilationError + do: []. + ^method +! ! + +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseTemporaries: aString + self on: aString; step. + ^self methodSignature notNil ifTrue: [self temporaries] +! ! + +!SSmalltalkParser methodsFor: 'ffi support' stamp: 'KenD 28/Jun/2026 13:27:40'! +symbolicPragma + | position symbol pragma | + position := token position. + symbol := self step value. + pragma := self buildNode: compiler pragmaNode at: position. + ^pragma symbol: symbol +! ! + +!SSmalltalkParser class methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parseSelector: aString + | cmp parser | + cmp := SCompiler new. + parser := self new compiler: cmp smalltalkCompiler; on: aString. + ^parser methodSelector ifNotNil: [:n | n value] +! ! + +!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildToken: aSmalltalkToken + ^self buildToken: aSmalltalkToken at: stream position +! ! + +!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildToken: aSmalltalkToken at: anInteger + | string | + string := stream copyFrom: anInteger to: stream position. + ^self buildToken: aSmalltalkToken at: anInteger with: string +! ! + +!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildToken: aSmalltalkToken at: anInteger with: anObject + ^aSmalltalkToken + position: anInteger; + value: anObject; + end: stream position +! ! + +!SSmalltalkScanner methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canBeInIdentifier: aCharacter + ^compiler frontend canBeInIdentifier: aCharacter +! ! + +!SSmalltalkScanner methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +canStartIdentifier: aCharacter + (compiler frontend canStartIdentifier: aCharacter) ifFalse: [^false]. + aCharacter = $_ + ifTrue: [^stream peek ifNil: [false] ifNotNil: [:ch | ch asInteger >= 33]]. + ^true +! ! + +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler + ^compiler +! ! + +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler. + compiler sourceCode ifNotNil: [:s | self sourceCode: s] +! ! + +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +on: aString + stream := aString readStream. + compiler notNil ifTrue: [compiler sourceCode: aString] +! ! + +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sourceCode: aString + stream := aString readStream +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +end + ^self buildToken: compiler endToken at: stream position + 1 +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBinary: aCharacter + | code | + aCharacter isNil ifTrue: [^false]. + code := aCharacter asInteger. + code < 128 ifTrue: [ + ^#($+ $- $< $> $= $* $/ $\ $| $& $~ $, $@ $% $? $!! $: $^) + includes: aCharacter]. + ^code > 255 +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +next + ^self nextToken +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextArrayPrefix + | string | + string := stream copyFrom: stream position - 1 to: stream position. + ^self + buildToken: compiler delimiterToken + at: stream position - 1 + with: string +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextAssignment + ^self buildToken: compiler delimiterToken at: stream position with: #':=' +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBinarySelector + stream back. + ^self + buildToken: compiler stringToken + at: stream position + 1 + with: self scanBinarySymbol +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextBinarySymbol + ^self + buildToken: compiler literalNode + at: stream position + with: self scanBinarySymbol +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextColon + | start char | + start := stream position. + char := stream peek. + ((char = Character space or: [char = Character tab]) and: [(stream peek: 2) second = $=]) ifTrue: [ + stream skip: 1. + char := $=]. + char = $= ifTrue: [ + stream skip. + ^self nextAssignment position: start]. + ^(self isBinary: stream peek) + ifTrue: [self nextBinarySelector] + ifFalse: [self nextSpecialCharacter] + +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextComment + | start comment | + start := stream position. + [ stream atEnd not and:[stream peek !!== $"] ] whileTrue: [stream next]. + stream atEnd ifTrue: [self error: 'unfinished comment' at: start]. + stream position: start. + comment := stream upTo: $". + ^self buildToken: compiler commentNode at: start with: comment + +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextIdentifierOrKeyword + | start | + start := stream position. + self skipIdentifier. + ((stream peekFor: $:) and: [stream peekFor: $=]) ifTrue: [stream skip: -2]. + ^self buildToken: compiler stringToken at: start +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextKeyword + | start string | + start := stream position + 1. + self skipKeyword. + string := stream copyFrom: start to: stream position. + ^self buildToken: compiler literalNode at: start - 1 with: string asSymbol +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextLiteralCharacter + stream atEnd ifTrue: [^self error: 'character expected']. + ^self + buildToken: compiler literalNode + at: stream position + with: stream next +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextLiteralString + ^self + buildToken: compiler literalNode + at: stream position + with: self scanString reduced +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextNumber + | parser assoc | + stream skip: -1. + parser := NumberParser new on: stream. + assoc := parser next. + parser error ifNotNil: [:e | ^self error: e key at: e value]. + ^self + buildToken: compiler numericLiteralNode + at: assoc value start + with: assoc key +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextQuotedSymbol + | node | + node := self nextLiteralString. + ^node beSymbol; position: node position - 1 +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextSpecialCharacter + | token | + token := self buildToken: compiler delimiterToken. + ^token beCharacter +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextSymbolOrArrayPrefix + | char | + stream atEnd ifTrue: [self error: 'character expected']. + char := stream peek. + (self canBeInIdentifier: char) ifTrue: [^self nextKeyword]. + (self isBinary: char) ifTrue: [^self nextBinarySymbol]. + stream next. + (char = $[ or: [char = $(]) ifTrue: [^self nextArrayPrefix]. + char = $' ifTrue: [^self nextQuotedSymbol]. + self error: 'character expected' +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +nextToken + | first | + first := self scanChar. + first isNil ifTrue: [^self end]. + (self canStartIdentifier: first) ifTrue: [^self nextIdentifierOrKeyword]. + (first = $→ or: [first = $_]) ifTrue: [^self nextAssignment]. + first = $: ifTrue: [^self nextColon]. + first = $' ifTrue: [^self nextLiteralString]. + first = $$ ifTrue: [^self nextLiteralCharacter]. + first = $# ifTrue: [^self nextSymbolOrArrayPrefix]. + first = $" ifTrue: [^self nextComment]. + first isDigit ifTrue: [^self nextNumber]. + (first !!= $^ and: [first !!= $↑ and: [self isBinary: first]]) + ifTrue: [^self nextBinarySelector]. + ^self nextSpecialCharacter +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +scanBinarySymbol + | start symbol | + start := stream position. + self skipBinary. + symbol := stream copyFrom: start + 1 to: stream position. + ^symbol asSymbol +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +scanChar + ^(stream skipSeparators; atEnd) ifFalse: [stream next] + +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +scanString + | current start | + start := current := stream position. + ^String streamContents: [:writer | + [| fragment | + fragment := stream upTo: $'. + writer nextPutAll: fragment. + (current < stream position and: [(stream back; next) = $']) + ifFalse: [self error: 'string end expected' at: start]. + stream peekFor: $'] + whileTrue: [ + writer nextPut: $'. + current := stream position]] +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipBinary + [self isBinary: stream peek] whileTrue: [stream next] +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipIdentifier + | frontend | + frontend := compiler frontend. + [stream atEnd] + whileFalse: [(frontend peekForIdentifier: stream) ifFalse: [^self]] +! ! + +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! +skipKeyword + | frontend continue pos | + frontend := compiler frontend. + [ + self skipIdentifier. + continue := false. + (stream peekFor: $:) ifTrue: [ + pos := stream position. + stream atEnd + ifFalse: [continue := frontend canStartIdentifier: stream peek]]. + continue] whileTrue. + pos isNil ifFalse: [stream position: pos] +! ! + +!SSmalltalkScanner methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString + ^self error: aString at: stream position +! ! + +!SSmalltalkScanner methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! +error: aString at: anInteger + ^compiler error: aString at: anInteger +! ! + +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +comment + ^comments notNil ifTrue: [comments anyOne] +! ! + +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +comments + ^comments +! ! + +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +comments: aCollection + aCollection isNil ifTrue: [^self]. + comments isNil + ifTrue: [comments := aCollection] + ifFalse: [comments addAll: aCollection] +! ! + +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! +moveCommentsTo: aParseNode + aParseNode comments: comments. + comments := nil +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compileWarning: aString + compiler notify: aString at: self stretch +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler + ^compiler +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +end + ^stretch end +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +end: aNumber + stretch end: aNumber +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +position + ^stretch start +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +position: aNumber + stretch start: aNumber +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prevPosition + ^stretch start - 1 +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +source + ^compiler sourceCode copyFrom: stretch start to: stretch end +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stretch + ^stretch +! ! + +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +stretch: aStretch + stretch := aStretch +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +endsExpression + ^self isEnd +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasSymbol + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +is: anObject + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isAssignment + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBar + ^(self is: #'|') or: [self is: #'/'] +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBlockNode + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isComment + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDelimiter + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isEnd + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isIdentifier + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isKeyword + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLiteral + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isNameToken + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isNumberNode + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isPoolLiteral + ^false +! ! + +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isStringToken + ^false +! ! + +!SToken methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + stretch := 1 thru: 0 +! ! + +!SToken methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDelimitedIdentifier + ^false +! ! + +!SEndToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isEnd + ^true +! ! + +!SEndToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +position: aNumber + super position: aNumber - 1 +! ! + +!SEndToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +prevPosition + ^stretch start +! ! + +!SEndToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: aString + '' +! ! + +!SParseNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:41'! +acceptVisitor: visitor + ^visitor visitParseNode: self +! ! + +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +allNodesDo: aBlock + self nodesDo: aBlock includingDeclarations: true +! ! + +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +nodeWithLiteral: anObject + ^self nodesDetect: [:n | (n isLiteral or: [n isSelector]) and: [n value = anObject]] ifAbsent: nil + +! ! + +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +nodesDetect: aBlock ifAbsent: absentBlock + self nodesDo: [:node | (aBlock value: node) ifTrue: [ ^node ] ] includingDeclarations: false. + ^absentBlock value +! ! + +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +nodesDo: aBlock + self nodesDo: aBlock includingDeclarations: false +! ! + +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +nodesDo: aBlock includingDeclarations: aBoolean + aBlock value: self +! ! + +!SParseNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +ast + ^compiler ast +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +hasAssign + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isAssign + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isBraceNode + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isCascade + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isCascadeMessage + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isEvaluable + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isImmediate + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isMessageNode + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isMethod + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isMethodArgument + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isMethodTemporary + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isReturn + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isSelector + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isSelf + ^false +! ! + +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isSuper + ^false +! ! + +!SParseNode methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:41'! +moveCommentsFrom: aParseNode + aParseNode moveCommentsTo: self +! ! + +!SParseNode methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:41'! +variableNamed: aString + self + allNodesDo: [:node | (node isIdentifier and: [node name = aString]) + ifTrue: [^node]]. + ^nil +! ! + +!SAssignmentNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitAssignment: self +! ! + +!SAssignmentNode methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:40'! +assign: anIdentifierNode operator: aDelimiterToken + assignees add: anIdentifierNode. + operators add: aDelimiterToken +! ! + +!SAssignmentNode methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:40'! +assign: anIdentifierNode with: aParseNode operator: aDelimiterToken + assignees add: anIdentifierNode. + operators add: aDelimiterToken. + expression := aParseNode +! ! + +!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +assignees + ^assignees +! ! + +!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +expression + ^expression +! ! + +!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +operators + ^operators +! ! + +!SAssignmentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasAssign + ^true +! ! + +!SAssignmentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isAssign + ^true +! ! + +!SAssignmentNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + assignees := OrderedCollection new: 1. + operators := OrderedCollection new: 1 +! ! + +!SAssignmentNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + assignees do: [:v | v nodesDo: aBlock includingDeclarations: aBoolean]. + expression nodesDo: aBlock includingDeclarations: aBoolean +! ! + +!SBraceNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitBraceNode: self +! ! + +!SBraceNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +asMessageNode + message notNil ifTrue: [^message]. + ^message := self expanded +! ! + +!SBraceNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBraceNode + ^true +! ! + +!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +elements + ^elements +! ! + +!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +elements: aCollection + elements := aCollection asArray +! ! + +!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +expanded + | receiver n new argument array messages i you yourself cascade | + receiver := compiler identifierNode name: 'Array'. + n := elements size. + new := compiler selectorNode symbol: #new:. + argument := compiler numericLiteralNode value: n. + array := compiler messageNode. + array receiver: receiver. + array selector: new. + array arguments: (Array with: argument). + i := 0. + messages := elements collect: [:elem | | msg sel idx args | + i := i + 1. + msg := compiler cascadeMessageNode position: elem position; end: elem end. + sel := compiler selectorNode symbol: #at:put:. + idx := compiler numericLiteralNode value: i. + args := Array with: idx with: elem. + msg selector: sel; arguments: args]. + you := compiler selectorNode symbol: #yourself. + yourself := compiler cascadeMessageNode. + yourself selector: you. + yourself arguments: #(). + messages := messages copyWith: yourself. + cascade := compiler cascadeNode receiver: array. + messages do: [:msg | msg cascade: cascade]. + ^cascade messages: messages +! ! + +!SBraceNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + elements do: [:n | n nodesDo: aBlock includingDeclarations: aBoolean] +! ! + +!SCascadeNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitCascade: self +! ! + +!SCascadeNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasAssign + receiver hasAssign ifTrue: [^true]. + messages detect: [:msg | msg hasAssign] ifNone: [^false]. + ^true +! ! + +!SCascadeNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCascade + ^true +! ! + +!SCascadeNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + receiver nodesDo: aBlock includingDeclarations: aBoolean. + messages do: [:msg | msg nodesDo: aBlock includingDeclarations: aBoolean] +! ! + +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +messages + ^messages +! ! + +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +messages: aCollection + messages := aCollection +! ! + +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +receiver + ^receiver +! ! + +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +receiver: rcvr + receiver := rcvr +! ! + +!SCommentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isComment + ^true +! ! + +!SCommentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^value +! ! + +!SCommentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: aString + value := aString +! ! + +!SIdentifierNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitIdentifier: self +! ! + +!SIdentifierNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +beAssigned + | immutable | + binding canBeAssigned ifTrue: [^self]. + immutable := binding isClassBinding + ifTrue: ['class'] + ifFalse: [compiler activeScope describe: binding name]. + self compileError: 'cannot assign to ' , immutable +! ! + +!SIdentifierNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +resolveAssigning: aBoolean + binding := compiler activeScope resolve: name. + ^binding + +! ! + +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +binding + ^binding +! ! + +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +binding: aBinding + binding := aBinding +! ! + +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + binding := DynamicBinding default +! ! + +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^name +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +checkLowercase + | char | + char := name first. + (char isLetter and: [char isUppercase]) ifFalse: [^self]. + self compileWarning: name storeString , ' should start with lowercase' +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isEvaluable + ^self isIdentifierLiteral +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isIdentifier + ^true +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isIdentifierLiteral + binding isDynamic ifFalse: [^binding isLiteral]. + ^self ast ifNil: [false] ifNotNil: [:ast | | b | + b := ast scope resolve: name. + b isLiteral] +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isImmediate + ^true +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isLocal + ^binding isLocal +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isMethodArgument + | ast | + binding isArgument ifFalse: [^false]. + ast := self ast ifNil: [^false]. + ^ast arguments includes: self declaration +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isMethodTemporary + ^self ast temporaries includes: self declaration +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSelf + ^binding isSelf +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isSuper + ^binding isSuper +! ! + +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +sourceIntervals + | stretchs declaration ast string code index | + stretchs := OrderedCollection new. + declaration := binding declaration. + ast := self ast. + ast allNodesDo: [:node | + (node class == self class and: [node binding declaration == declaration]) + ifTrue: [stretchs add: node stretch]]. + string := self source. + code := compiler sourceCode. + index := ast stretch end. + [ + index := code indexOfString: string startingAt: index + 1. + index > 0] + whileTrue: [stretchs add: (index to: index + string size - 1)]. + ^stretchs +! ! + +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +declaration + ^binding declaration +! ! + +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +defineArgumentIn: aScriptScope + binding := aScriptScope defineArgument: name. + binding declaration: self +! ! + +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +defineTemporaryIn: scope + binding := scope defineTemporary: name. + binding declaration: self +! ! + +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +printOn: aStream + aStream nextPut: $<; + nextPutAll: name; + nextPutAll: '> ('. + super printOn: aStream. + aStream nextPut: $) +! ! + +!SIdentifierNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +name: aString + name := aString reduced +! ! + +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +acceptVisitor: visitor + ^visitor visitLiteral: self +! ! + +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +hasSymbol + ^value isSymbol +! ! + +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isEvaluable + ^true +! ! + +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isImmediate + ^true +! ! + +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isLiteral + ^true +! ! + +!SLiteralNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +beSymbol + value := value asSymbol +! ! + +!SLiteralNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +value + ^value +! ! + +!SLiteralNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +value: anObject + value := anObject +! ! + +!SNumberNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitNumberNode: self +! ! + +!SNumberNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isNumberNode + ^true +! ! + +!SNumberNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +negate + value := value negated +! ! + +!SMessageNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitMessage: self +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arguments + ^arguments +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arguments: aCollection + arguments := aCollection +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +receiver + ^receiver +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +receiver: node + receiver := node +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +selector + ^selector +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +selector: node + selector := node +! ! + +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +symbol + ^selector symbol +! ! + +!SMessageNode methodsFor: 'emitting - inlined' stamp: 'KenD 28/Jun/2026 13:27:40'! +beInlined + inlined := true +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasAssign + receiver hasAssign ifTrue: [^true]. + ^arguments anySatisfy: [:arg | arg hasAssign] +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasVolatileArguments + ^arguments anySatisfy: [:arg | + arg isIdentifier + ifTrue: [arg binding canBeAssigned] + ifFalse: [arg isBlockNode not andNot: [arg isLiteral]]] +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasVolatileReceiver + ^ compiler hasBlocks + or: [ receiver isMethodTemporary not ] + or: [ arguments anySatisfy: [ :arg | arg hasAssign ] ] +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + inlined := false +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCascadeMessage + ^false +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInlined + ^inlined +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isMessageNode + ^true +! ! + +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +needsStrictEvaluationOrder + arguments size = 0 ifTrue: [^false]. + receiver isBlockNode ifTrue: [^false]. + receiver isLiteral ifTrue: [^false]. + receiver isSelf ifTrue: [^false]. + receiver isSuper ifTrue: [^false]. + receiver isMethodArgument ifTrue: [^false]. + self hasVolatileReceiver ifFalse: [^false]. + (receiver isImmediate + and: [arguments conform: [:arg | arg isImmediate or: [arg isBlockNode]]]) + ifTrue: [^false]. + receiver hasAssign ifTrue: [^true]. + receiver isMessageNode ifTrue: [ ^true ]. + ^self hasVolatileArguments +! ! + +!SMessageNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + receiver nodesDo: aBlock includingDeclarations: aBoolean. + arguments do: [:arg | arg nodesDo: aBlock includingDeclarations: aBoolean]. + selector nodesDo: aBlock includingDeclarations: aBoolean +! ! + +!SCascadeMessageNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitCascadeMessage: self +! ! + +!SCascadeMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +cascade: aCascadeNode + cascade := aCascadeNode. + receiver := cascade receiver +! ! + +!SCascadeMessageNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +from: aMessageNode + arguments := aMessageNode arguments. + receiver := aMessageNode receiver. + selector := aMessageNode selector. + inlined := aMessageNode isInlined. + stretch := aMessageNode stretch. + comments := aMessageNode comments +! ! + +!SCascadeMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isCascadeMessage + ^true +! ! + +!SCascadeMessageNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + aBlock value: self. + arguments do: [:arg | arg nodesDo: aBlock includingDeclarations: aBoolean] +! ! + +!SReturnNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitReturn: self +! ! + +!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +expression + ^expression +! ! + +!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +expression: node + expression := node +! ! + +!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +return: aSmalltalkToken + return := aSmalltalkToken +! ! + +!SReturnNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasAssign + ^expression hasAssign +! ! + +!SReturnNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isReturn + ^true +! ! + +!SReturnNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + expression nodesDo: aBlock includingDeclarations: aBoolean +! ! + +!SScriptNode methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:40'! +addChild: aBlockNode + children add: aBlockNode +! ! + +!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +addStatements: anOrderedCollection + statements addAll: anOrderedCollection +! ! + +!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +identifiers + | result | + result := OrderedCollection new. + self nodesDo: [:node | node isIdentifier ifTrue: [result add: node]]. + ^result withoutDuplicates +! ! + +!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + statements := OrderedCollection new. + arguments := #(). + temporaries := #(). + children := OrderedCollection new +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arguments + ^arguments +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +arguments: aCollection + arguments := aCollection +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +children + ^children +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentSize + ^scope environmentSize +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +realScript + self subclassResponsibility +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +statements + ^statements +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaries + ^temporaries +! ! + +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +temporaries: aCollection + temporaries := aCollection +! ! + +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +bindLocals + arguments do: [:arg | arg defineArgumentIn: scope]. + temporaries do: [:temp | temp checkLowercase; defineTemporaryIn: scope]. + children do: [:block | block bindLocals] +! ! + +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +positionLocals + scope positionLocals. + children do: [:b | b positionLocals] +! ! + +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +reference: aBinding + aBinding beReferencedFrom: self +! ! + +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! +scope + ^scope +! ! + +!SScriptNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasAssign + statements do: [:s | s hasAssign ifTrue: [^true]]. + ^false +! ! + +!SScriptNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + aBoolean ifTrue: [ + arguments do: [:a | a nodesDo: aBlock includingDeclarations: aBoolean]. + temporaries do: [:a | a nodesDo: aBlock includingDeclarations: aBoolean]]. + statements do: [:s | s nodesDo: aBlock includingDeclarations: aBoolean] +! ! + +!SScriptNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +useSelf + scope captureSelf +! ! + +!SBlockNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: visitor + ^visitor visitBlock: self +! ! + +!SBlockNode methodsFor: 'emitting - inlined' stamp: 'KenD 28/Jun/2026 13:27:40'! +beInlined + inlined := true. + arguments do: [:arg | arg binding beInlined] +! ! + +!SBlockNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +buildBlock + | block | + self isInlined ifTrue: [ ^ nil ]. + block := CompiledBlock new. + ^ block + blockNumber: index; + argumentCount: arguments size; + tempCount: scope stackSize; + environmentCount: scope environmentSize; + capturesSelf: scope capturesSelf; + capturesHome: scope capturesHome +! ! + +!SBlockNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +captureHome + scope captureEnvironment: self ast +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +environmentIndexOf: aParseNode + ^scope environmentIndexOf: aParseNode +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBlockNode + ^true +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isEvaluable + ^self isNullary +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isInlined + ^inlined +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isNullary + ^arguments isEmpty +! ! + +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +usesHome + ^inlined + ifTrue: [children anySatisfy: [:block | block usesHome]] + ifFalse: [scope capturesHome] +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index + ^index +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +index: aNumber + index := aNumber +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parent + ^parent +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +parent: aScriptNode + parent := aScriptNode addChild: self +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +realParent + ^parent realScript +! ! + +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +realScript + ^inlined ifTrue: [parent realScript] ifFalse: [self] +! ! + +!SBlockNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + inlined := false. + scope := BlockScope on: self +! ! + +!SMethodNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:41'! +acceptVisitor: visitor + ^visitor visitMethod: self +! ! + +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +buildMethod + | cm encoder treecodes | + cm := self methodClass withAll: self literals. + cm + blockCount: compiler blockCount; + tempCount: scope stackSize; + argumentCount: arguments size; + environmentCount: scope environmentSize; + capturesSelf: scope capturesSelf; + hasEnvironment: self needsEnvironment; + hasFrame: self needsFrame; + selector: self selector; + sourceObject: compiler sourceCode; + classBinding: compiler frontend classBinding. + cm pragma: pragma. + cm blocks do: [ :block | block method: cm ]. + encoder := TreecodeEncoder new method: cm. + treecodes := self acceptVisitor: encoder. + ^ cm treecodes: treecodes +! ! + +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +captureHome + +! ! + +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +literals + | literals v l | + literals := OrderedCollection new. + pragma isUsed + ifTrue: [ literals add: pragma name ]. + self + nodesDo: [ :n | + n isLiteral + ifTrue: [ v := n value. + v isSmallInteger + ifFalse: [ literals add: v ] ]. + n isMessageNode + ifTrue: [ literals add: n symbol ]. + n isBraceNode + ifTrue: [ n isLiteral + ifTrue: [ self halt ] + ifFalse: [ literals + add: #Array; + add: #new:; + add: #at:put:; + add: #yourself ] ]. + (n isIdentifier + and: [ l := n binding literal. + l notNil ]) + ifTrue: [ literals add: l ]. + (n isBlockNode andNot: [ n isInlined ]) + ifTrue: [ literals add: n buildBlock ] ]. + ^ literals withoutDuplicates +! ! + +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! +methodClass + | type | + type := pragma type. + type = #callback + ifTrue: [ ^ CallbackMethod ]. + type = #callout + ifTrue: [ ^ CalloutMethod ]. + ^ CompiledMethod +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +compiler: aSmalltalkCompiler + super compiler: aSmalltalkCompiler. + scope := MethodScope new script: self. + pragma := aSmalltalkCompiler pragmaNode +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +pragma + ^pragma +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +pragma: anObject + pragma := anObject +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +realScript + ^self +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +selector + ^selector value +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +selector: aSelectorNode + selector := aSelectorNode +! ! + +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +selectorNode + ^selector +! ! + +!SMethodNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! +environmentIndexOf: aParseNode + ^nil +! ! + +!SMethodNode methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:41'! +header + " + (Object >> #printOn:) ast header + " + | interval | + interval := selector stretch. + arguments notEmpty + ifTrue: [interval := interval start thru: arguments last stretch end]. + ^compiler sourceCode copyFrom: interval start to: interval end +! ! + +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isHeadless + ^selector isNil +! ! + +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isMethod + ^true +! ! + +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +needsEnvironment + ^scope environmentSize > 0 + or: [children anySatisfy: [:block | block usesHome]] +! ! + +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +needsFrame + scope stackSize > 0 ifTrue: [ ^ true ]. + arguments size > 16 ifTrue: [ ^ true ]. + compiler hasSends ifTrue: [ ^ true ]. + compiler hasBlocks ifTrue: [ ^ true ]. + ^ false +! ! + +!SMethodNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + (aBoolean and: [selector notNil]) ifTrue: [aBlock value: selector] +! ! + +!SSelectorNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:41'! +acceptVisitor: visitor + ^visitor visitSelector: self +! ! + +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 30/Jun/2026 08:25:59'! +addKeyword: aSelectorNode + keywords isNil ifTrue: [keywords := OrderedCollection new]. + keywords add: aSelectorNode +! ! + +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +end + stretch end ifNotNil: [:e | ^e]. + ^keywords notNil ifTrue: [keywords last end] +! ! + +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +keywords + ^keywords isNil ifTrue: [{self}] ifFalse: [keywords] +! ! + +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! +positions + ^self keywords collect: [:node | node position] +! ! + +!SSelectorNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +hasSymbol + ^symbol isSymbol +! ! + +!SSelectorNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +isSelector + ^true +! ! + +!SSelectorNode methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:41'! +isBinary + ^symbol isBinary +! ! + +!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +symbol + ^symbol +! ! + +!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +symbol: aString + symbol := aString asSymbol +! ! + +!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! +value + ^symbol +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +acceptVisitor: aVisitor + self isFFI ifTrue: [^aVisitor visitFFIPragma: self]. + self isPrimitive ifTrue: [^aVisitor visitPrimitivePragma: self]. + self isSymbolic ifTrue: [^aVisitor visitSymbolicPragma: self] +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffi: cc name: aString with: anFFIDescriptor + type := cc. + name := aString. + info := anFFIDescriptor +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +ffi: aString with: anFFIDescriptor + type := #ffi. + name := aString. + info := anFFIDescriptor +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +info + ^info +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +isUsed + ^type notNil +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + ^name +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +primitive: anInteger name: aString + type := #primitive. + name := aString. + info := anInteger +! ! + +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! +type + ^type +! ! + +!SSymbolicToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +is: anObject + ^value == anObject +! ! + +!SSymbolicToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value + ^value +! ! + +!SSymbolicToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: anObject + value := anObject +! ! + +!SDelimiterToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! +asSelectorNode + ^compiler selectorNode symbol: value asString; stretch: stretch +! ! + +!SDelimiterToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +beCharacter + value := value isCharacter ifTrue: [value] ifFalse: [value first] +! ! + +!SDelimiterToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! +value: aString + super value: aString asSymbol +! ! + +!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +endsExpression + ^value = $. or: [value = $]] or: [value = $)] or: [value = $}] +! ! + +!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isAssignment + ^self is: #':=' +! ! + +!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDelimiter + ^true +! ! + +!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! +asIdentifierNode + ^compiler identifierNode + name: value; + stretch: stretch; + comments: comments +! ! + +!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! +asSelectorNode + ^compiler selectorNode symbol: value; stretch: stretch +! ! + +!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! +isStringToken + ^true +! ! + +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +hasSymbol + ^value isSymbol +! ! + +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isBinary + ^value isSymbol +! ! + +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isDelimitedIdentifier + ^value first = ${ +! ! + +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isKeyword + ^value last = $: +! ! + +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +isNameToken + ^(self isKeyword or: [self isBinary]) not +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: aString + ^merged at: aString ifAbsent: [nil] +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +at: aString ifAbsent: aBlock + ^merged at: aString ifAbsent: aBlock +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +dependencies + ^self at: 'dependencies' ifAbsent: [OrderedDictionary new] +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +modulePaths + | paths section | + paths := self at: 'paths'. + paths ifNil: [^#()]. + section := paths at: 'modules' ifAbsent: [nil]. + section ifNil: [^#()]. + ^section +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name + | section | + section := self at: 'project'. + section ifNil: [^nil]. + ^section at: 'name' ifAbsent: [nil] +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +project + ^project +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +user + ^user +! ! + +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +version + | section | + section := self at: 'project'. + section ifNil: [^nil]. + ^section at: 'version' ifAbsent: [nil] +! ! + +!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +load + self loadUser. + self loadProject. + self merge +! ! + +!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadProject + | cwd path contents | + cwd := Kernel currentDirectory. + path := cwd, '/epm.toml'. + (Kernel pathExists: path) + ifTrue: [ + contents := Kernel readFile: path. + project := TOMLParser parse: contents] + ifFalse: [project := OrderedDictionary new] +! ! + +!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadUser + | home path contents | + home := Kernel getEnv: 'HOME'. + home ifNil: [user := OrderedDictionary new. ^self]. + path := home, '/.egg/config.toml'. + (Kernel pathExists: path) + ifTrue: [ + contents := Kernel readFile: path. + user := TOMLParser parse: contents] + ifFalse: [user := OrderedDictionary new] +! ! + +!Config methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +merge + merged := OrderedDictionary new. + self mergeFrom: user into: merged. + self mergeFrom: project into: merged +! ! + +!Config methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +mergeFrom: aSource into: aTarget + aSource keysAndValuesDo: [:k :v | + | existing | + existing := aTarget at: k ifAbsent: [nil]. + (v isKindOf: OrderedDictionary) + ifTrue: [ + (existing isKindOf: OrderedDictionary) + ifTrue: [self mergeFrom: v into: existing] + ifFalse: [ + | copy | + copy := OrderedDictionary new. + self mergeFrom: v into: copy. + aTarget at: k put: copy]] + ifFalse: [aTarget at: k put: v]] +! ! + +!Config class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! +load + ^self new load +! ! + +!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +dir: aString + dir := aString +! ! + +!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +moduleName + | first | + first := name first asUppercase. + ^(String with: first), (name copyFrom: 2) +! ! + +!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +name: aString + name := aString +! ! + +!ProjectGenerator methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +ensureDir + dir ifNil: [ + dir := Kernel currentDirectory, '/', name]. + Kernel createDirectory: dir +! ! + +!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026 13:27:40'! +generate + | modules module | + self ensureDir. + modules := dir, '/modules'. + module := modules, '/', self moduleName. + Kernel createDirectory: modules. + Kernel createDirectory: module. + self generateToml. + self generateModule: module +! ! + +!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026 13:27:40'! +generateModule: aString + | filename contents module | + module := self moduleName. + filename := aString, '/', module, 'Module.st'. + contents := '" + See (MIT) license in root directory. +" + +Class { + #name : #', module, 'Module, + #superclass : #Module, + #instVars : [], + #category : #', module, ' +} + +{ #category : #main } +', module, 'Module >> main: args [ + Kernel log: ''Hello from ', name, ''' +] +'. + Kernel writeFile: filename contents: contents +! ! + +!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026 13:27:40'! +generateToml + | filename contents | + self ensureDir. + filename := dir, '/epm.toml'. + contents := '[project] +name = "', name, '" +version = "0.1.0" +description = "" + +[dependencies] +'. + Kernel writeFile: filename contents: contents +! ! + +!LMRObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +size + ^self primitiveSize +! ! + +!Module methodsFor: 'snapshotting' stamp: 'KenD 28/Jun/2026 13:27:38'! +prepareForSnapshot: aBuilder + aBuilder + importNilToken; + addBoundary: Symbol symbolTable as: SymbolicReference symbolTable; + map: overriden to: Dictionary new +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +addClass: aClass + classes add: aClass. + self exportClass: aClass +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +addExtension: aCompiledMethod + | collection | + collection := extensions at: aCompiledMethod classBinding symbol ifAbsentPut: [OrderedCollection new]. + collection add: aCompiledMethod. +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +addOverride: aCompiledMethod + overriden at: aCompiledMethod signature put: aCompiledMethod +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +bind + classes + reject: [:c | classes includes: c superclass] + thenDo: [:c | c superclass addSubclass: c]. + extensions keysAndValuesDo: [:s :methods | | meta key target | + meta := s endsWith: ' class'. + key := meta ifTrue: [(s trimTail: ' class') asSymbol] ifFalse: [s]. + target := namespace at: key ifAbsent: [self _halt]. + meta ifTrue: [target := target class]. + methods do: [:m | | current extension | + current := target compiledMethodAt: m selector. + extension := m asExtensionFor: self. + target addSelector: m selector withMethod: extension. + current notNil ifTrue: [current module addOverride: current]] + ] +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +bind: anObject as: aSymbol + namespace at: aSymbol put: anObject. + self justDefined: aSymbol +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +bindKernelExports + | bindings | + bindings := Dictionary new. + { + Object. Class. Metaclass. CompiledMethod. + Array. OrderedCollection. Set. Dictionary. + SmallInteger. String. Character. + } do: [:class | + bindings at: class symbol put: class]. + bindings at: #Kernel put: Kernel. + self bindAll: bindings +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +export: anObject as: aSymbol + namespace at: aSymbol put: anObject. + exports add: aSymbol +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +exportClass: aClass + self export: aClass as: aClass name asSymbol +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +exports + | result | + result := Dictionary new. + result at: '__module__' put: self. + exports do: [:name | | value | + value := namespace at: name. + result at: name put: value]. + ^result +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +import: moduleName + | module | + namespace at: moduleName ifPresent: [:loaded | ^loaded]. + module := Kernel load: moduleName. + self bind: module as: moduleName. + ^module +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +import: name from: moduleName + ^self import: name from: moduleName as: name +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +import: name from: moduleName as: newName + | module import | + module := Kernel load: moduleName. + import := module namespace at: name. + self bind: import as: newName +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +importDescriptor: descriptor + | moduleName token exportNames | + moduleName := descriptor key. + token := descriptor value. + exportNames := token isArray ifTrue: [token] ifFalse: [{token}]. + exportNames do: [:name | self import: name from: moduleName] +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +importRequiredModules + requires do: [:name | self import: name]. + self imports do: [:descriptor | self importDescriptor: descriptor] +! ! + +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +imports + " + Returns an array of import descriptors. A descriptor can be: + - A composite symbol (i.e #Core.Modules.Writer) (NOT IMPLEMENTED YET). + - An association of module name and exported name (i.e #Core.Modules.JSON -> #Writer) + - An association of module name, exported name and rename (i.e. #Core.Modules.JSON -> (#Writer -> #JSONWriter)) (NOT IMPLEMENTED YET) + " + ^#() +! ! + +!Module methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicInitialize + name := self defaultName. + namespace ifNil: [namespace := Namespace new]. + exports := Set new. + cachedLookups := Dictionary new. + classes := OrderedCollection new. + extensions := Dictionary new. + overriden := Dictionary new. + requires := #() +! ! + +!Module methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +defaultName + | classname | + classname := self class name. + (classname endsWith: 'Module') ifTrue: [^classname trimTail: 'Module']. + (classname beginsWith: 'Module') ifTrue: [^classname trimPrefix: 'Module']. + ^classname +! ! + +!Module methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +bindAll: aDictionary + aDictionary keysAndValuesDo: [:symbol :value | + namespace at: symbol put: value. + self justDefined: symbol]. +! ! + +!Module methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +justDefined: aSymbol + | lookups | + lookups := cachedLookups at: aSymbol ifAbsent: [^nil]. + lookups do: [:lookup | lookup flush] +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classes + ^classes +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +extensions + ^extensions +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +justLoaded + self bind +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name + ^name +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +name: aString + name := aString +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +namespace + ^namespace +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +originalMethodFor: aCompiledMethod + aCompiledMethod module == self ifTrue: [^aCompiledMethod]. + ^overriden at: aCompiledMethod signature ifAbsent: nil +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +overriden + ^overriden +! ! + +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +requires + ^requires +! ! + +!Module methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +classNamed: aString + ^classes detect: [:cls | cls name = aString ] ifNone: nil +! ! + +!Module methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +extensionClasses + ^extensions keys + collect: [:s | | key | + key := (s endsWith: ' class') ifTrue: [(s trimTail: ' class') asSymbol] ifFalse: [s]. + namespace at: key ifAbsent: [Class new name: (s , '__Not_Found') asSymbol]] +! ! + +!Module methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isModule + ^true +! ! + +!Module class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self basicNew basicInitialize +! ! + +!ArgParserModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(Error OrderedDictionary). + } +! ! + +!CodeSpecsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! +imports + ^{ + #Kernel -> #(#OrderedDictionary). + } +! ! + +!TestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:41'! +imports + ^{ + #Kernel -> #(Array Error Exception OrderedCollection UndefinedObject WideString WideSymbol). + #Compiler -> #(SCompiler SCompilationError SMethodNode SSelectorNode SMessageNode SStringToken InlinedArgEnvironment MethodScope). + #SUnit -> #(TestCase TestResult TestSuite) + } +! ! + +!TestsModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:41'! +main: anArray + | suite result | + Kernel log: 'Running Compiler tests... +'. + suite := TestSuite forModule: self. + Kernel log: 'suite built with ', suite tests size printString, ' tests +'. + result := suite run. + Kernel log: 'Done. +'. + Kernel log: result printString. + Kernel log: ' +' +! ! + +!CompilerModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:40'! +initialize + super initialize. + TreecodeEncoder initializeBindingIds; initializeTreecodeIds. + self initializeClosureElementIds +! ! + +!CompilerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! +imports + ^{ + #Kernel -> #(Error ByteArray CompiledBlock Module NumberParser Species OrderedDictionary) + } +! ! + +!CompilerModule methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! +initializeClosureElementIds + self namespace + at: #CaptureSelf put: 0; + at: #CaptureLocalArgument put: 1; + at: #CaptureEnvironment put: 2; + at: #CaptureEnvironmentValue put: 3; + at: #CaptureInlinedArgument put: 4 +! ! + +!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +addCommand: aString description: aDescription action: aSymbol + | command | + command := Command new + name: aString; + description: aDescription. + command action: [:result | self perform: aSymbol with: result]. + parser addCommand: command. + ^command +! ! + +!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +loadConfig + | host | + config := Config load. + host := Kernel host. + config modulePaths do: [:path | + host prependSearchPath: path type: #tonel. + host prependSearchPath: path type: #ems] +! ! + +!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! +setupParser + | create | + parser := ArgParser new name: 'epm'; description: 'Egg Package Manager'. + create := self addCommand: 'new' description: 'Create a new project' action: #commandNew:. + create addPositional: 'name'. + self addCommand: 'init' description: 'Initialize epm.toml in current directory' action: #commandInit:. + self addCommand: 'start' description: 'Run current project' action: #commandStart:. + self addCommand: 'dev' description: 'Start development environment for current project' action: #commandDev:. + self addCommand: 'install' description: 'Install dependencies from epm.toml' action: #commandInstall:. + self addCommand: 'list' description: 'List project dependencies' action: #commandList:. + ((self addCommand: 'test' description: 'Run tests for a module' action: #commandTest:) + addPositional: 'module'; + addOption: (Option new + long: '--debug'; + description: 'Run tests without swallowing exceptions'; + beFlag; + yourself)) +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandDev: aResult + | cwd name dev module | + cwd := Kernel currentDirectory. + name := cwd copyAfterLast: $/. + dev := Kernel load: #Development. + module := Kernel load: name asSymbol. + dev main: args +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandInit: aResult + | cwd name generator | + cwd := Kernel currentDirectory. + name := cwd copyAfterLast: $/. + name isEmpty ifTrue: [name := 'myproject']. + generator := ProjectGenerator new. + generator name: name. + generator dir: cwd. + generator generateToml. + Kernel log: 'Initialized epm.toml for: ', name +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandInstall: aResult + | dependencies | + config ifNil: [self loadConfig]. + dependencies := config dependencies. + dependencies isEmpty ifTrue: [ + Kernel log: 'No dependencies to install'. + ^self]. + Kernel log: 'Installing dependencies...'. + dependencies keysAndValuesDo: [:name :constraint | + Kernel log: ' ', name, ' (', constraint asString, ')']. + Kernel log: 'Done' +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandList: aResult + | dependencies | + config ifNil: [self loadConfig]. + dependencies := config dependencies. + dependencies isEmpty ifTrue: [ + Kernel log: 'No dependencies'. + ^self]. + Kernel log: config name ifNil: ['(unnamed project)']. + dependencies keysAndValuesDo: [:name :constraint | + Kernel log: ' ', name, ' ', constraint asString] +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandNew: aResult + | name generator | + aResult positionals isEmpty ifTrue: [ + ^self error: 'Usage: epm new ']. + name := aResult positionalAt: 1. + generator := ProjectGenerator new. + generator name: name. + generator generate. + Kernel log: 'Created project: ', name +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandStart: aResult + | cwd name module | + cwd := Kernel currentDirectory. + name := cwd copyAfterLast: $/. + module := Kernel load: name asSymbol. + module main: args +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +commandTest: aResult + | name module positionals | + positionals := aResult positionals. + name := positionals isEmpty + ifTrue: [self projectName] + ifFalse: [positionals first]. + name ifNil: [ + ^self error: 'Usage: epm test [module-name]']. + module := Kernel load: (name, '.Tests') asSymbol. + (aResult optionAt: 'debug') == true + ifTrue: [self debugTestModule: module] + ifFalse: [module main: args] +! ! + +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! +debugTestModule: aModule + Kernel log: 'Running ', aModule name, ' tests in debug mode...'; log: String cr. + (TestSuite forModule: aModule) runDebug. + Kernel log: 'Done.'; log: String cr +! ! + +!EPMModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! +imports + ^{ + #Kernel -> #(Error OrderedDictionary). + #ArgParser -> #(ArgParser Command Option). + #SUnit -> #(TestSuite). + #TOML -> #(TOMLParser TOMLWriter). + } +! ! + +!EPMModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:40'! +main: aCollection + | params | + args := aCollection. + self loadConfig. + self setupParser. + params := OrderedCollection new. + 3 to: args size do: [:i | + | arg | + arg := args at: i. + params add: arg]. + parser parse: params asArray +! ! + +!EPMModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! +projectName + ^config ifNotNil: [config name] +! ! + +!LMRModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! +imports + ^{ + #Kernel -> #(ArrayedCollection CharacterArray Closure Float ProtoObject Species Symbol) + } +! ! + +!ModuleImporterModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! +imports + ^{ + #Kernel -> #(#InternalReadStream #Character #CharacterArray #IdentitySet #Module). + #Tonel -> #(#TonelReader). + #CodeSpecs -> #(#ModuleSpec #ClassSpec #MetaclassSpec #MethodSpec). + #STON -> #(#STONReader). + #Compiler -> #(#SCompiler). + } +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +checkNumberEnd: position + | char | + stream atEnd ifTrue: [^self]. + char := stream peek. + char = $. ifFalse: [^self]. + stream skip: 1. + stream atEnd + ifFalse: [stream peek isDigit + ifTrue: [self error: 'invalid number' at: position]]. + stream skip: -1 +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +completeFloat: anInteger + | tenth | + tenth := 10 raisedToInteger: self nextExponent. + ^(anInteger * tenth) asFloat +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +completeNumber: anInteger after: aCharacter + aCharacter = $. ifTrue: [ + ^(stream peekFor: $s) + ifTrue: [self nextScaledFrom: anInteger fractionDigits: 0] + ifFalse: [self nextFloat: anInteger]]. + (aCharacter = $e or: [aCharacter = $E]) + ifTrue: [^self completeFloat: anInteger]. + aCharacter = $r ifTrue: [^self nextIntegerRadix: anInteger]. + aCharacter = $s ifTrue: [^self nextScaledFrom: anInteger fractionDigits: 0]. + (anInteger = 0 and: [aCharacter = $x or: [aCharacter = $X]]) + ifTrue: [^self nextIntegerRadix: 16]. + stream skip: -1. + ^anInteger +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +completeNumber: anInteger at: start + | number | + stream atEnd ifTrue: [^anInteger]. + number := anInteger. + number := self completeNumber: anInteger after: stream next. + self checkNumberEnd: start. + ^number +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +digitFromChar: char base: radix + | c | + char isDigit ifTrue: [^char digitValue]. + char = $r ifTrue: [^nil]. + char = $x ifTrue: [^nil]. + char = $X ifTrue: [^nil]. + c := char asUppercase. + (c asInteger between: $A asInteger and: $Z asInteger) ifFalse: [^nil]. + (c !!= $E and: [radix <= c digitValue]) ifTrue: [^nil]. + (c = $E and: [radix = 10]) ifTrue: [^nil]. + ^c digitValue +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +endToken + self error: 'end of stream' at: stream position +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +error: aString at: position + error := aString -> position. + return value: nil +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +negativeNumber + | position | + stream atEnd ifTrue: [^nil]. + stream peek isDigit ifFalse: [^nil]. + position := stream position. + ^self next key negated -> position +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +next + | char | + return isNil ifTrue: [return := [:value | ^value]]. + char := self nextChar. + char isNil ifTrue: [^self endToken]. + char = $- ifTrue: [^self negativeNumber]. + char = $+ ifTrue: [^self positiveNumber]. + char isDigit ifTrue: [^self nextNumber: char]. + ^nil +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextChar + ^stream skipWhitespace atEnd ifFalse: [stream next] +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextDigit: radix + | char digit | + stream atEnd ifTrue: [^nil]. + char := stream next. + digit := self digitFromChar: char base: radix. + digit isNil ifTrue: [ + stream skip: -1. + ^nil]. + radix <= digit + ifTrue: [self error: 'digit greater than radix' at: stream position]. + ^digit +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextExponent + | negated exp | + negated := false. + (stream peekFor: $+) ifFalse: [negated := stream peekFor: $-]. + exp := self nextIntegerRadix: 10. + negated ifTrue: [exp := exp negated]. + ^exp +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextFloat: aNumber + | base digit e exp | + digit := self nextDigit: 10. + digit isNil ifTrue: [ + stream skip: -1. + ^aNumber]. + e := 1. + base := aNumber * 10 + digit. + [ + digit := self nextDigit: 10. + digit isNil] + whileFalse: [ + base := base * 10 + digit. + e := e + 1]. + ((stream peekFor: $E) or: [stream peekFor: $e]) ifTrue: [ + exp := self nextExponent. + ^(base * (10 raisedToInteger: exp - e)) asFloat]. + (stream peekFor: $s) ifTrue: [^self nextScaledFrom: base fractionDigits: e]. + ^(base * (10 raisedToInteger: e negated)) asFloat +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextIntegerRadix: radix + | value valid digit | + value := 0. + valid := false. + [ + digit := self nextDigit: radix. + digit isNil] + whileFalse: [ + valid := true. + value := value * radix + digit]. + valid ifFalse: [self error: 'digit missing' at: stream position + 1]. + ^value +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextNumber: aCharacter + | start number digit | + start := stream position. + number := aCharacter digitValue. + [ + digit := self nextDigit: 10. + digit isNil] + whileFalse: [number := number * 10 + digit]. + number := self completeNumber: number at: start. + ^number -> (start thru: stream position) +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextScaledFrom: aNumber fractionDigits: digits + | scale denominator sd | + scale := (stream atEnd not and: [stream peek isDigit]) + ifTrue: [self nextIntegerRadix: 10]. + denominator := 10 raisedToInteger: digits. + sd := ScaledDecimal + numerator: aNumber + denominator: denominator + scale: scale. + ^sd reduced +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +positiveNumber + | position | + stream peek isDigit ifFalse: [^nil]. + position := stream position. + ^self next key -> position +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +reset + stream reset. + return := nil +! ! + +!NumberParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +error + ^error +! ! + +!NumberParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aString + stream := aString readStream. + return := nil +! ! + +!NumberParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +nextValue + ^self next ifNil: [0] ifNotNil: [:assoc | assoc key] +! ! + +!ObjectReference methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! +beAbsolute + absolute := true +! ! + +!ObjectReference methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! +classBinding + ^source classBinding +! ! + +!ObjectReference methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +for: anObject + self target: anObject +! ! + +!ObjectReference methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + absolute := false +! ! + +!ObjectReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isAbsolute + ^absolute +! ! + +!ObjectReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isMethod + ^false +! ! + +!ObjectReference methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: 'Ref to ' , target printString +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +source: sourceObject + source := sourceObject +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sourceOffset + ^sourceOffset +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +sourceOffset: aNumber + sourceOffset := aNumber +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +target + ^target +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +target: anObject + target := anObject +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +targetOffset + ^0 +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueToWriteAt: sourceAddress with: wordSize + ^self + valueToWriteAt: sourceAddress + targeting: target _asSmallInteger + with: wordSize +! ! + +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueToWriteWith: wordSize + ^self valueToWriteAt: source _asSmallInteger + sourceOffset with: wordSize +! ! + +!ObjectReference methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! +valueToWriteAt: sourceAddress targeting: targetAddress with: wordSize + | address correction | + address := targetAddress + self targetOffset. + correction := absolute + ifTrue: [0] + ifFalse: [sourceAddress + sourceOffset + wordSize]. + ^address - correction +! ! + +!ObjectReference class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +absoluteFor: anObject + ^(self new for: anObject) beAbsolute +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +_instancesAreArrayed + ^format & Variable = Variable +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +_instancesAreFixed + ^format & Variable = 0 +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +_instancesHavePointers + ^format & Pointers !!= 0 +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +canUnderstand: aSymbol + ^instanceBehavior implements: aSymbol +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +includesSelector: aSymbol + ^self methodDictionary includesKey: aSymbol +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instancesAreArrayed + ^self _instancesAreArrayed +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instancesHavePointers + ^self _instancesHavePointers +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isBytes + ^self _instancesHavePointers not +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isCategorized + ^self organization notNil +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isSpecies + ^true +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isVariable + ^self _instancesAreArrayed +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +>> aSelector + ^self compiledMethodAt: aSelector +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVariableAssociationAt: aString + | c assoc | + c := self. + [ + c isNil ifTrue: [^nil]. + c classVariables notNil and: [ + assoc := c classVariables associationAt: aString ifAbsent: nil. + assoc notNil]] + whileFalse: [c := c superclass]. + ^assoc +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +classVariableString + | stream | + stream := '' writeStream. + self classVarNames asSortedCollection + do: [:cvar | stream nextPutAll: cvar] + separatedBy: [stream space]. + ^stream contents +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +compiledMethodAt: aSymbol + ^self methodDictionary at: aSymbol ifAbsent: nil +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +fillFrom: aClass + | ivars | + self == aClass ifTrue: [^self]. + format := aClass format. + ivars := aClass instVarNames. + instanceVariables := ivars notEmpty ifTrue: [ivars] +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +format + ^format +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +format: anInteger + format := anInteger +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instVarNames: aCollection + instanceVariables := aCollection isEmpty + ifFalse: [ + self isBytes ifTrue: [^self error: 'byte objects cannot have named instance variables']. + aCollection asArray]. + self updateInstSize; allSubspeciesDo: [:class | class updateInstSize] +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +instanceBehavior + ^instanceBehavior +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodDictionary + ^instanceBehavior methods +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +selectors + ^self methodDictionary keys +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +superclass + ^superclass +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +superclass: aClass + superclass := aClass +! ! + +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +timestamp + ^organization notNil ifTrue: [organization timestamp] +! ! + +!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:38'! +addSelector: aSymbol withMethod: aCompiledMethod + | selector | + selector := aSymbol asSymbol. + self methodDictionary at: selector put: aCompiledMethod. + self organization notNil ifTrue: [self organization classify: selector] +! ! + +!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeSelector: aSymbol + self methodDictionary removeKey: aSymbol ifAbsent: []. + self organization notNil ifTrue: [self organization remove: aSymbol] +! ! + +!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:38'! +removeSubclass: aClass + " + do nothing + " + +! ! + +!Species methodsFor: 'hierarchy' stamp: 'KenD 28/Jun/2026 13:27:38'! +addSubclass: aClass + | copy | + (self subclasses includes: aClass) ifTrue: [^self]. + copy := self subclasses copyWith: aClass. + self subclasses: copy. + aClass superclass: self +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allClassVarNames + ^(self withAllSuperclasses reversed gather: [:cls | cls classVarNames]) asArray +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allInstVarNames + ^(self withAllSuperclasses reversed gather: [:class | class instVarNames]) asArray +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSubclasses + | all | + all := OrderedCollection new. + self allSubclassesDo: [:cls | all add: cls]. + ^all +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSubclassesDo: aBlock + self subclassesDo: [:class | + aBlock value: class. + class allSubclassesDo: aBlock] +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSubinstances + | subinstances | + subinstances := OrderedCollection new. + [ + self + withAllSubclassesDo: [:cls | subinstances + addAll: cls allExistingInstances]] + evaluateAtomically. + ^subinstances asArray +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSubspecies + | all | + all := OrderedCollection new. + self allSubspeciesDo: [:cls | all add: cls]. + ^all +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSubspeciesDo: aBlock + self subspeciesDo: [:class | + aBlock value: class. + class allSubspeciesDo: aBlock] +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSuperclasses + | superclasses | + superclasses := OrderedCollection new. + self allSuperclassesDo: [:s | superclasses add: s]. + ^superclasses +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +allSuperclassesDo: aBlock + superclass isNil ifTrue: [^self]. + aBlock value: superclass. + superclass allSuperclassesDo: aBlock +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodsReadingInstVar: aString + | methods index | + methods := OrderedCollection new. + index := self indexOfSlot: aString. + index = 0 ifTrue: [^methods]. + self methodDictionary + select: [:cm | cm usesInstanceVariable: index] + thenDo: [:cm | methods add: cm]. + ^methods +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodsReferencingClassVar: aString + | methods assoc | + methods := OrderedCollection new. + assoc := self classVariableAssociationAt: aString. + assoc isNil ifTrue: [^methods]. + self instanceClass methodDictionary + & self instanceClass class methodDictionary + select: [:cm | cm referencesAssociation: assoc] + thenDo: [:cm | methods add: cm]. + ^methods +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodsReferencingInstVar: aString + | methods index | + methods := OrderedCollection new. + index := self indexOfSlot: aString. + index = 0 ifTrue: [^methods]. + self methodDictionary + select: [:cm | cm referencesInstanceVariable: index] + thenDo: [:cm | methods add: cm]. + ^methods +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +methodsWritingInstVar: aString + | methods index | + methods := OrderedCollection new. + index := self indexOfSlot: aString. + index = 0 ifTrue: [^methods]. + self methodDictionary + select: [:cm | cm assignsInstanceVariable: index] + thenDo: [:cm | methods add: cm]. + ^methods +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +selectorsInCategory: aSymbol + ^self organization selectorsFor: aSymbol +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAllSubclasses + ^OrderedCollection with: self withAll: self allSubclasses +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAllSubspecies + ^OrderedCollection with: self withAll: self allSubspecies +! ! + +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAllSuperclasses + ^OrderedCollection with: self withAll: self allSuperclasses +! ! + +!Species methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! +allInstances + ^Kernel memory allInstancesOf: self +! ! + +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew + ^self errorVMSpecific +! ! + +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew: anInteger + ^self errorVMSpecific +! ! + +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self errorVMSpecific +! ! + +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self errorVMSpecific +! ! + +!Species methodsFor: 'flags' stamp: 'KenD 28/Jun/2026 13:27:38'! +bePointers + format := Pointers + self instSize +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +browse + Smalltalk browsingTools browse: self +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +buildBehavior + | behavior | + behavior := Behavior with: self methodDictionary copy. + superclass ifNotNil: [behavior next: superclass instanceBehavior]. + instanceBehavior := behavior +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +instVarNames + instanceVariables isNil ifTrue: [^#()]. + instanceVariables isArray ifTrue: [^instanceVariables]. + ^instanceVariables substrings +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +instanceVariableString + ^String streamContents: [:strm | + self instVarNames + do: [:ivar | strm nextPutAll: ivar] + separatedBy: [strm space]] +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +kindOfSubclass + self _instancesAreFixed ifTrue: [^'subclass:']. + self isBytes ifTrue: [^'variableByteSubclass:']. + self _instancesHavePointers ifTrue: [^'variableSubclass:']. + self error: 'invalid type of subclass' +! ! + +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +updateClassifications + organization notNil ifTrue: [organization updateOn: self] +! ! + +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! +categories + ^self organization notNil + ifTrue: [self organization categoriesOn: self] + ifFalse: [#()] +! ! + +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! +categorizedSelectors + ^self organization notNil + ifTrue: [self organization allSelectors] + ifFalse: [#()] +! ! + +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! +hasUnclassifiedSelectors + ^self categorizedSelectors size < self methodDictionary size +! ! + +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! +organization + organization isNil ifTrue: [self initializeOrganization]. + ^organization +! ! + +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! +organization: aClassOrganizer + organization := aClassOrganizer +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +categoryFor: selector + | category | + self organization notNil ifTrue: [ + category := self organization categoryFor: selector. + category notNil ifTrue: [^category]]. + ^ClassOrganizer default +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +classImplementing: aSymbol + (self methodDictionary includesKey: aSymbol) ifTrue: [^self]. + ^self allSuperclasses + detect: [:class | class includesSelector: aSymbol] + ifNone: [] +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +depth + " + Object depth + SmallInteger depth 4 + " + | depth ancestor | + depth := 0. + ancestor := self superclass. + ancestor notNil ifTrue: [depth := ancestor depth + 1]. + ^depth +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +inheritsFrom: aClass + | class | + class := self. + [class == nil] whileFalse: [ + class == aClass ifTrue: [^true]. + class := class superclass]. + ^false +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +instSize + ^format & 16r7F +! ! + +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +shouldBeHidden: aSymbol + ^false +! ! + +!Species methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +deepCopy + ^self +! ! + +!Species methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! +shallowCopy + ^self +! ! + +!Species methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! +errorNotIndexable + ^self error: 'Instances of ' , self name , ' are not indexable' +! ! + +!Species methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeOrganization + self + organization: (ClassOrganizer new classifyAll: self selectors under: nil) +! ! + +!Species methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +instanceBehavior: aBehavior + instanceBehavior := aBehavior +! ! + +!Species methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +updateInstSize + | size | + size := superclass isNil ifTrue: [0] ifFalse: [superclass instSize]. + format := format - self instSize + size + self instVarNames size +! ! + +!Species methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNewBytes: size + ^self errorVMSpecific +! ! + +!Species methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPutAll: self name +! ! + +!Species methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAllSubclassesDo: aBlock + aBlock evaluateWith: self. + self allSubclassesDo: aBlock +! ! + +!Species methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! +withAllSuperclassesDo: aBlock + aBlock evaluateWith: self. + self allSuperclassesDo: aBlock +! ! + +!Species class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeFormatFlags + Flags := self addNamespace. + Flags + at: #Variable put: 16r2000; + at: #Pointers put: 16r4000 +! ! + +!Species class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +maxInstVarCount + ^16r7F +! ! + +!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchFirstAfterStartOn: aMatchAlgorithm + aMatchAlgorithm matchFirstStar +! ! + +!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchFirstOn: aMatchAlgorithm + aMatchAlgorithm matchFirstStar +! ! + +!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! +matchLastOn: aMatchAlgorithm + " + do nothing + " + +! ! + +!StarToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream nextPut: $* +! ! + +!StarToken class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +current + ^current +! ! + +!StarToken class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeCurrent + current := self new +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! ++ delta + delta isInteger ifTrue: [^start + delta thru: end + delta]. + delta isPoint ifTrue: [^start + delta x thru: end + delta y]. + ^start + delta start thru: end + delta end +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +- delta + ^self + delta negated +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +// anInteger + ^start // anInteger thru: end // anInteger +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +center + ^start + end // 2 +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +down: anInteger + ^start thru: end + anInteger +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +length + ^end - start + 1 +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 30/Jan/2023 10:10:45'! +mask + ^(2 raisedTo: end) - (2 raisedTo: start - 1) +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +max + ^start max: end +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +min + ^start min: end +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! +negated + ^start negated thru: end negated +! ! + +!Stretch methodsFor: 'arithmetic' stamp: 'KenD 30/Jan/2023 10:10:45'! +shift + ^(start - 1) negated +! ! + +!Stretch methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! += aStretch + self class == aStretch class ifFalse: [^false]. + ^start = aStretch start and: [end = aStretch end] +! ! + +!Stretch methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! +hash + ^start hashWith: end +! ! + +!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +end + ^end +! ! + +!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +end: anInteger + end := anInteger +! ! + +!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +start + ^start +! ! + +!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +start: anInteger + start := anInteger +! ! + +!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +includes: anInteger + ^anInteger between: start and: end +! ! + +!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +intersects: aStretch + self isEmpty ifTrue: [^false]. + (aStretch includes: start) ifTrue: [^true]. + ^aStretch includes: end +! ! + +!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +isEmpty + ^end < start +! ! + +!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +notEmpty + ^start <= end +! ! + +!Stretch methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + aStream + nextPutAll: start asString; + nextPutAll: ' thru: '; + nextPutAll: end asString +! ! + +!Stretch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +from: start thru: end + ^self new start: start; end: end +! ! + +!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:38'! +addStar + stream atEnd ifTrue: [^self]. + tokens add: StarToken current. + stream next. + [stream peek ifNil: [^self] ifNotNil: [:c | c isAsterisk]] + whileTrue: [stream next] +! ! + +!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:38'! +addToken + | star pos end token | + star := false. + pos := stream position + 1. + [stream atEnd or: [star := stream next isAsterisk]] whileFalse. + star ifTrue: [stream skip: -1]. + end := stream position. + pos <= end ifTrue: [ + token := MatchToken on: stream collection from: pos to: end. + tokens add: token] +! ! + +!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:38'! +scan + [stream atEnd] whileFalse: [self addToken; addStar] +! ! + +!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +input + ^stream contents +! ! + +!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aString + stream := aString readStream. + tokens := OrderedCollection new. + self scan +! ! + +!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +tokens + ^tokens copy +! ! + +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +match: aString + ^self match: aString index: 1 +! ! + +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +match: aString ifAbsent: aBlock + ^self match: aString index: 1 ifAbsent: aBlock +! ! + +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +match: aString index: anInteger + ^self match: aString index: anInteger ifAbsent: nil +! ! + +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +match: aString index: anInteger ifAbsent: aBlock + | algorithm | + algorithm := MatchAlgorithm new + pattern: self; + string: aString; + index: anInteger. + algorithm run. + algorithm hasMatched ifTrue: [^algorithm matchRange]. + ^aBlock notNil ifTrue: [ + aBlock arity = 0 + ifTrue: [aBlock value] + ifFalse: [aBlock evaluateWith: algorithm failure]] +! ! + +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! +matches: aString + | range | + range := self match: aString. + ^range notNil and: [range x = 1 and: [range y = aString size]] +! ! + +!StringPattern methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! +printOn: aStream + tokens do: [:t | t printOn: aStream] +! ! + +!StringPattern class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +on: aString + ^self new on: aString +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterIndexOf: aString at: anInteger + | index s | + index := 0. + s := 0. + [s < anInteger] whileTrue: [| ch len | + index := index + 1. + ch := aString at: index. + len := self sizeOfCharacter: ch. + s := s + len]. + ^index +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeStringFrom: aStream + ^self + decodeStringFrom: aStream + length: aStream size // self minBytesPerChar +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeStringFrom: aStream length: anInteger + | string | + string := String new: anInteger. + ^self decodeStringFrom: aStream on: string +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeStringFrom: aStream on: buffer + | bytes code string index n | + bytes := true. + index := 0. + code := nil. + string := buffer. + n := string size. + [aStream atEnd or: [code = 0] or: [index >= n]] whileFalse: [ + code := self decodeFrom: aStream. + (bytes andNot: [Ansi isAnsi: code]) ifTrue: [ + bytes := false. + string := string asWideString]. + code = 0 ifFalse: [ + index := index + 1. + string at: index putCode: code]]. + ^index < string size ifTrue: [string copyTo: index] ifFalse: [string] +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +externalCopyOf: aString + | bytes | + aString isNil ifTrue: [^nil]. + bytes := self parameterFrom: aString. + ^bytes externalCopy +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexesOf: aString from: start to: end + " + UTF16 current indexesOf: (WideString with: $𝑎 with: $_ with: $𝑎 with: $→) from: 2 to: 3 + " + | s e | + s := 1. + 1 to: start - 1 do: [:i | | ch len | + ch := aString at: i. + len := self sizeOfCharacter: ch. + s := s + len]. + e := s - 1. + start to: end do: [:i | | ch len | + ch := aString at: i. + len := self sizeOfCharacter: ch. + e := e + len]. + ^s thru: e +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isString: s1 greaterThan: s2 + ^(self compareStringiW: s1 with: s2) > 0 +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isString: s1 greaterThanOrEqualTo: s2 + ^(self compareStringiW: s1 with: s2) >= 0 +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isString: s1 lessThan: s2 + ^(self compareStringiW: s1 with: s2) < 0 +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isString: s1 lessThanOrEqualTo: s2 + ^(self compareStringiW: s1 with: s2) <= 0 +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +lowercaseOf: aString + ^UTF16 current lowercaseOf: aString +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytesOf: aString + | size | + size := self sizeOfCharacter: Character null. + 1 to: aString size do: [:i | | ch s | + ch := aString at: i. + s := self sizeOfCharacter: ch. + size := size + s]. + ^size +! ! + +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +uppercaseOf: aString + ^UTF16 current uppercaseOf: aString +! ! + +!Unicode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +compareStringiW: aString1 with: aString2 + ^UTF16 current compareStringiW: aString1 with: aString2 +! ! + +!Unicode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +minBytesPerChar + ^1 +! ! + +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decode: aByteArray + ^self decodeStringFrom: aByteArray readStream +! ! + +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFrom: aStream + self subclassResponsibility +! ! + +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aString + ^ByteArray + streamContents: [:strm | aString do: [:ch | self encode: ch on: strm]] +! ! + +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aCharacter on: aStream + self subclassResponsibility +! ! + +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decode: aByteArray + ^self current decode: aByteArray +! ! + +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeBytes: aByteArray + | decoder stream | + stream := aByteArray readStream. + decoder := self decoderFor: stream. + ^decoder decode: stream upToEnd +! ! + +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFromAddress: externalAddress length: anInteger + ^self current + decodeStringFrom: externalAddress readStream + length: anInteger +! ! + +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decoderFor: aStream + (aStream peekForAll: UTF32 prefix) ifTrue: [^UTF32]. + (aStream peekForAll: UTF16 prefix) ifTrue: [^UTF16]. + ^UTF8 +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterIndexOf: aString at: anInteger + (self isDBS: aString upTo: anInteger - 1) ifTrue: [^anInteger]. + ^super characterIndexOf: aString at: anInteger * 2 +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +characterIndexesOf: aString from: start to: end + " + UTF16 current characterIndexesOf: '𝑎𝑎𝑎x' from: 3 to: 5 + " + | i e s max n | + aString isWideString ifFalse: [^start thru: end]. + s := i := self characterIndexOf: aString at: start. + n := aString size. + max := end * 2. + e := start * 2. + [i < n and: [e <= max]] whileTrue: [| ch len | + i := i + 1. + ch := aString at: i. + len := self sizeOfCharacter: ch. + e := e + len]. + ^s thru: i - 1 +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +indexesOf: aString from: start to: end + | e stretch delta | + e := start - 1 max: end - 1. + (self isDBS: aString upTo: e) ifTrue: [ + delta := end > 0 + ifTrue: [self sizeOfCharacter: (aString at: end)] + ifFalse: [0]. + ^start thru: end - 1 + (delta // 2)]. + stretch := super indexesOf: aString from: start to: end. + ^stretch + 1 // 2 +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDBS: aString + ^self isDBS: aString upTo: aString size +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +isDBS: aString upTo: anInteger + aString isWide ifFalse: [^true]. + 2 + to: anInteger * 4 + by: 4 + do: [:i | (aString uShortAtOffset: i) = 0 ifFalse: [^false]]. + ^true +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +lengthOf: aString + ^(self encode: aString) size // 2 +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +parameterFrom: aString + | strm | + strm := (ByteArray new: aString size + 1 * 2) writeStream. + aString isCharacter + ifTrue: [self encode: aString on: strm] + ifFalse: [aString do: [:char | self encode: char on: strm]]. + strm nextPut: 0; nextPut: 0. + ^strm contents +! ! + +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeInBytesOf: aString + aString isWideString ifFalse: [^aString size + 1 * 2]. + ^super sizeInBytesOf: aString +! ! + +!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFrom: aStream + | b1 b2 hi b3 b4 lo | + b1 := aStream nextByte. + b2 := aStream nextByte. + hi := b1 + (b2 bitShift: 8). + b2 < 16rD8 ifTrue: [^hi]. + hi := hi - 16rD800. + hi < 16r400 ifFalse: [^b2 * 256 + b1]. + hi := (hi bitShift: 10) + 16r10000. + b3 := aStream nextByte. + b4 := aStream nextByte. + lo := (b4 bitShift: 8) - 16rDC00 + b3. + ^hi + lo +! ! + +!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aCharacter on: aStream + | code c20 hi lo | + code := aCharacter codePoint. + code < 128 ifTrue: [ + aStream nextPut: code; nextPut: 0. + ^self]. + code < 16rD800 ifTrue: [ + aStream + nextPut: (code bitAnd: 16rFF); + nextPut: (code bitShift: -8). + ^self]. + code < 16rE000 ifTrue: [self error: 'invalid code point']. + code < 16r10000 ifTrue: [ + aStream + nextPut: (code bitAnd: 16rFF); + nextPut: (code bitShift: -8). + ^self]. + code < 16r110000 ifTrue: [ + c20 := code - 16r10000. + hi := (c20 bitShift: -10) + 16rD800. + lo := (c20 bitAnd: 16r3FF) + 16rDC00. + aStream + nextPut: (hi bitAnd: 16rFF); + nextPut: (hi bitShift: -8); + nextPut: (lo bitAnd: 16rFF); + nextPut: (lo bitShift: -8). + ^self]. + self error: 'invalid code point' +! ! + +!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeOfCharacter: aCharacter + ^aCharacter codePoint < 16r10000 ifTrue: [2] ifFalse: [4] +! ! + +!UTF16 methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +minBytesPerChar + ^2 +! ! + +!UTF16 class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFromAddress: externalAddress length: anInteger + | stream | + stream := externalAddress readStream readLimit: anInteger * 2. + ^self current decodeStringFrom: stream length: anInteger +! ! + +!UTF16 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prefix + ^#[16rFE 16rFF] +! ! + +!UTF32 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decode: aByteArray + ^WideString newFrom: aByteArray +! ! + +!UTF32 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aCharacter on: aStream + aStream nextULongPut: aCharacter codePoint +! ! + +!UTF32 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prefix + ^#[16rFE 16rFF 0 0] +! ! + +!UTF8 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +accepts: aByteArray + | stream | + stream := aByteArray readStream. + [stream atEnd] whileFalse: [| s | + s := self sizeOfEncoding: stream next. + s = 0 ifTrue: [^false]. + s - 1 timesRepeat: [ + stream atEnd ifTrue: [^false]. + (stream next bitAnd: 0xC0) = 0x80 ifFalse: [^false]]]. + ^true +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decode: aByteArray + aByteArray isExternalMemory + ifTrue: [^self class decodeMemory: aByteArray length: aByteArray length]. + 1 + to: aByteArray size + do: [:i | (aByteArray at: i) asInteger > 127 + ifTrue: [^super decode: aByteArray]]. + ^aByteArray asString +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeFrom: aStream + | b1 flags count bytes b2 b3 b4 | + b1 := aStream nextByte. + b1 < 128 ifTrue: [^b1]. + flags := b1 bitAnd: 16rF8. + count := self trailing: flags. + count isNil ifTrue: [^b1]. + bytes := aStream peek: count. + bytes size < count ifTrue: [^b1]. + 1 + to: count + do: [:i | ((bytes byteAt: i) bitAnd: 16rC0) = 16r80 ifFalse: [^b1]]. + aStream skip: count. + count = 1 ifTrue: [ + b2 := bytes byteAt: 1. + b1 := b1 bitAnd: 16r1F. + ^(b1 bitShift: 6) + (b2 bitAnd: 16r3F)]. + count = 2 ifTrue: [ + b2 := (bytes byteAt: 1) bitAnd: 16r3F. + b3 := (bytes byteAt: 2) bitAnd: 16r3F. + b1 := b1 bitAnd: 16rF. + ^(b1 bitShift: 12) + (b2 bitShift: 6) + b3]. + b2 := (bytes byteAt: 1) bitAnd: 16r3F. + b3 := (bytes byteAt: 2) bitAnd: 16r3F. + b4 := (bytes byteAt: 3) bitAnd: 16r3F. + b1 := b1 bitAnd: 7. + ^(b1 bitShift: 18) + (b2 bitShift: 12) + (b3 bitShift: 6) + b4 +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aString + aString class = String ifTrue: [ + 1 + to: aString size + do: [:i | (aString codeAt: i) < 128 ifFalse: [^super encode: aString]]. + ^aString asByteArray]. + ^super encode: aString +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encode: aCharacter on: aStream + | code b1 b2 b3 b4 | + code := aCharacter codePoint. + code < 128 ifTrue: [ + aStream nextBytePut: code. + ^self]. + code < 16r800 ifTrue: [ + b1 := code bitShift: -6. + b1 := b1 bitOr: 16rC0. + b2 := code bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + aStream nextBytePut: b1; nextBytePut: b2. + ^self]. + code < 16r10000 ifTrue: [ + b1 := code bitShift: -12. + b1 := b1 bitOr: 16rE0. + b2 := code bitShift: -6. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + aStream + nextBytePut: b1; + nextBytePut: b2; + nextBytePut: b3. + ^self]. + b1 := code bitShift: -18. + b1 := b1 bitOr: 16rF0. + b2 := code bitShift: -12. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitShift: -6. + b3 := b3 bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + b4 := code bitAnd: 16r3F. + b4 := b4 bitOr: 16r80. + aStream + nextBytePut: b1; + nextBytePut: b2; + nextBytePut: b3; + nextBytePut: b4 +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +encodeCharacter: aCharacter + | code b1 b2 b3 b4 | + code := aCharacter codePoint. + code < 128 ifTrue: [^ByteArray with: code]. + code < 16r800 ifTrue: [ + b1 := code bitShift: -6. + b1 := b1 bitOr: 16rC0. + b2 := code bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + ^ByteArray with: b1 with: b2]. + code < 16r10000 ifTrue: [ + b1 := code bitShift: -12. + b1 := b1 bitOr: 16rE0. + b2 := code bitShift: -6. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + ^ByteArray with: b1 with: b2 with: b3]. + b1 := code bitShift: -18. + b1 := b1 bitOr: 16rF0. + b2 := code bitShift: -12. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitShift: -6. + b3 := b3 bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + b4 := code bitAnd: 16r3F. + b4 := b4 bitOr: 16r80. + ^ByteArray with: b1 with: b2 with: b3 with: b4 +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeOfCharacter: aCharacter + | code | + code := aCharacter codePoint. + code < 128 ifTrue: [^1]. + code < 16r800 ifTrue: [^2]. + code < 16r10000 ifTrue: [^3]. + ^4 +! ! + +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! +sizeOfEncoding: code + code < 0x80 ifTrue: [^1]. + code < 0xC0 ifTrue: [^0]. + code < 0xE0 ifTrue: [^2]. + code < 0xF0 ifTrue: [^3]. + code < 0xF8 ifTrue: [^4]. + ^0 +! ! + +!UTF8 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +parameterFrom: aString + | strm | + strm := (ByteArray new: aString size + 1) writeStream. + aString isCharacter + ifTrue: [self encode: aString on: strm] + ifFalse: [aString do: [:char | self encode: char on: strm]]. + strm nextPut: 0. + ^strm contents +! ! + +!UTF8 methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +trailing: byte + (byte bitAnd: 2r11100000) = 2r11000000 ifTrue: [^1]. + (byte bitAnd: 2r11110000) = 2r11100000 ifTrue: [^2]. + (byte bitAnd: 2r11111000) = 2r11110000 ifTrue: [^3]. + ^nil +! ! + +!UTF8 class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! +accepts: aByteArray + ^self current accepts: aByteArray +! ! + +!UTF8 class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +decodeMemory: anExternalMemory length: anInteger + ^Smalltalk os utf8ToWide: anExternalMemory length: anInteger +! ! + +!UTF8 class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +encodeMemory: anExternalMemory length: anInteger + " + UTF8 encodeMemory: '→' externalCopy length: 2 + " + Smalltalk os wideToUtf8: anExternalMemory length: anInteger +! ! + +!UTF8 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +prefix + ^#[16rEF 16rBB 16rBF] +! ! + +!ModuleLoader methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:37'! +loadModuleNamed: aString + | classes moduleName moduleSpec moduleClass | + spec := self readModuleSpecNamed: aString. + classes := self classesSortedBySuperclass: spec classes. + moduleName := ('.' split: spec name) last asSymbol. + moduleSpec := spec classes detect: [:cls | cls name = (moduleName , #Module)] ifNone: nil. + moduleSpec ifNil: [ moduleSpec := spec classes detect: [:cls | cls name = (#Module , moduleName)] ifNone: nil]. + moduleSpec + ifNil: [ + moduleClass := Module.] + ifNotNil: [ + moduleClass := self createNewClassFrom: moduleSpec in: nil. + classes remove: moduleSpec ]. + module := self createNewModule: moduleClass. + module name isEmpty ifTrue: [ module name: moduleName asString ]. + classes do: [:c | self createNewClassFrom: c in: module ]. + spec extendedClasses do: [:c | self createExtensionMethodsOf: c ]. + module justLoaded. + Kernel loadedModules at: module name asSymbol put: module. + ^ module +! ! + +!ModuleLoader methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:37'! +readModuleSpecNamed: aString + | reader | + reader := ModuleSpecReader new. + reader path: '../../modules/', aString. + ^reader read +! ! + +!ModuleLoader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! +classesSortedBySuperclass: anArray + | result seen s dfs | + result := OrderedCollection new. + seen := IdentitySet new. + dfs := [ :class | + s := class superclass. + ((anArray includes: s) andNot: [ seen includes: s ]) ifTrue: [ + dfs value: s ]. + result add: class. + seen add: class ]. + anArray do: [ :class | (seen includes: class) ifFalse: [ dfs value: class ] ]. + self ASSERT: result asSet = anArray asSet. + ^ result +! ! + +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! +createExtensionMethodsOf: aClassSpec + | class metaclass | + class := module namespace at: aClassSpec name asSymbol. + metaclass := class behavior classBinding. + aClassSpec methods do: [ :m | | cm | + cm := self createNewMethod: m in: class. + module ifNotNil: [ module addExtension: cm ] ]. + aClassSpec metaclass methods do: [ :m | | cm | + cm := self createNewMethod: m in: metaclass. + module ifNotNil: [ module addExtension: cm ] ]. + ^ module +! ! + +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! +createNewClassFrom: aClassSpec in: module + | superclass metaclass class | + superclass := (module ifNil: [ Kernel ]) namespace at: aClassSpec supername asSymbol. + class := Class newSubclassOf: superclass. + metaclass := class class. + class name: aClassSpec name; instVarNames: aClassSpec instVarNames; classVarNames: aClassSpec classVarNames. + aClassSpec methods do: [ :m | self createNewMethod: m in: class ]. + aClassSpec metaclass methods do: [ :m | self createNewMethod: m in: metaclass ]. + module ifNotNil: [ + module addClass: class. + class module: module]. + ^ class +! ! + +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! +createNewMethod: aMethodSpec in: aSpecies + | method selector | + method := SCompiler new compile: aMethodSpec sourceCode. + selector := method selector. + method classBinding: aSpecies. + aSpecies methodDictionary at: selector put: method. + aSpecies organization classify: selector under: method category. + ^method +! ! + +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! +createNewModule: aClass + | module | + module := aClass new. + module bindKernelExports; importRequiredModules. + aClass name !!= #Module ifTrue: [ aClass module: module. module addClass: aClass]. + ^module +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +read + self readMetadata; readClasses; readExtendedClasses. + ^module +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readClass: aString + | filename reader definition pointers variable class metasclass stream contents | + filename := path / aString , '.st'. + contents := Kernel readFile: filename. + contents size = 0 ifTrue: [ + filename := path / aString , '.class.st'. + contents := Kernel readFile: filename. + contents size = 0 ifTrue: [ + self error: 'Cannot find file for class ' , aString]]. + stream := InternalReadStream on: contents. + reader := TonelReader on: stream. + [reader read] ensure: [stream close]. + definition := reader definition. + variable := pointers := true. + definition at: #type ifPresent: [:type | + variable := true. + type = #bytes ifTrue: [pointers := false]]. + class := ClassSpec new + module: module; + name: (definition at: #name) asString; + supername: (definition at: #superclass ifAbsent: nil) asString; + ivars: (definition at: #instVars ifAbsent: #()); + cvarNames: (definition at: #classVars ifAbsent: #()); + sharedPools: (definition at: #pools ifAbsent: #()); + isVariable: variable; + isPointers: pointers. + metasclass := MetaclassSpec new + module: module; + instanceClass: class; + ivars: (definition at: #classInstVars ifAbsent: #()). + class metaclass: metasclass. + module addClass: class. + reader methods do: [:m | self readMethod: m] +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readClasses + (metadata at: #classes) do: [:name | self readClass: name] +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readExtendedClass: aString + + | filename contents stream reader definition class metaclass | + filename := path / aString , '.st'. + contents := Kernel readFile: filename. + contents size = 0 ifTrue: [ + self error: 'Cannot find file for extended class ' , aString]. + stream := InternalReadStream on: contents. + reader := TonelReader on: stream. + [reader read] ensure: [stream close]. + definition := reader definition. + class := ClassSpec new + module: module; + name: (definition at: #name) asString. + metaclass := MetaclassSpec new module: module; instanceClass: class. + class metaclass: metaclass. + module addClassExtension: class. + reader methods do: [:m | self readMethod: m] +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readExtendedClasses + (metadata at: #extendedClasses ifAbsent: [#()]) + do: [:name | self readExtendedClass: name] +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readMetadata + | stream name classes | + stream := (Kernel readFile: path , '/package.st') readStream. + stream throughAll: 'Package '. + metadata := (STONReader on: stream) parseMap. + name := (metadata at: #name) replace: $- with: Character space. + module name: name asString. + classes := metadata at: #classes. + classes := classes copyWith: name asString, 'Module'. + metadata at: #classes put: classes +! ! + +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! +readMethod: aDictionary + | classname selector category class signature body source method | + classname := aDictionary at: #class. + selector := aDictionary at: #selector. + category := aDictionary at: #category. + class := module resolveClass: classname. + class isNil ifTrue: [ + self + error: 'Cannot find class for method ' , classname , ' >> #' + , selector asString]. + signature := aDictionary at: #signature. + body := aDictionary at: #body. + source := signature dosToUnix unixToMac , String cr + , body dosToUnix unixToMac. + method := MethodSpec new + module: module; + classBinding: class; + selector: selector; + category: category; + source: source. + class addMethod: method +! ! + +!ModuleSpecReader methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +initialize + super initialize. + module := ModuleSpec new +! ! + +!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +module + ^module +! ! + +!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +module: aModuleSpec + module := aModuleSpec +! ! + +!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! +path: aFilename + path := aFilename +! ! + +!MessageInlinerTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:27:41'! +ast: source + ^SCompiler new parse: source +! ! + +!MessageInlinerTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:27:41'! +cascadeMessagesIn: source + | ast cascadeMessages | + ast := self ast: source. + cascadeMessages := OrderedCollection new. + ast nodesDo: [:n | + (n isMessageNode and: [n isCascadeMessage]) + ifTrue: [cascadeMessages add: n]]. + ^cascadeMessages +! ! + +!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +testCascadeAndKeywordIsNotInlined + "Regression: a keyword cascade message such as `at:put:` must not be inlined." + | messages | + messages := self cascadeMessagesIn: 'foo + ^Dictionary new at: #a put: 1; at: #b put: 2; yourself'. + messages do: [:m | self deny: m isInlined] +! ! + +!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +testCascadeIfTrueIsNotInlined + "Regression: ifTrue: as the first message of a cascade must not be inlined, + because the cascade machinery needs the receiver (a Boolean) to receive + the subsequent messages. This is the pattern that the original + InternalReadStream>>peekFor: relied on: + ^self peek = token ifTrue: [position := position + 1]; yourself" + | messages | + messages := self cascadeMessagesIn: 'foo + ^true ifTrue: [42]; yourself'. + self assert: messages size = 2. + messages do: [:m | self deny: m isInlined] +! ! + +!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +testCascadeWhileTrueIsNotInlined + "Regression: whileTrue: in a cascade must not be inlined either." + | messages | + messages := self cascadeMessagesIn: 'foo + ^[true] whileTrue: [^1]; yourself'. + messages do: [:m | self deny: m isInlined] +! ! + +!MessageInlinerTest methodsFor: 'tests - non-cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +testNonCascadeIfTrueIsInlined + "Sanity check: outside a cascade, ifTrue: is still inlined as expected." + | ast inlined | + ast := self ast: 'foo + ^true ifTrue: [42]'. + inlined := false. + ast nodesDo: [:n | + (n isMessageNode and: [n isInlined]) + ifTrue: [inlined := true]]. + self assert: inlined +! ! + +!SmalltalkScannerTest methodsFor: 'setup' stamp: 'KenD 28/Jun/2026 13:27:41'! +setUp + super setUp. + scanner := SCompiler new smalltalkScanner +! ! + +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +test0xNotation + | node | + node := SCompiler new smalltalkParser parseExpression: '0x10'. + self assert: node statements first value = 16. + node := SCompiler new smalltalkParser parseExpression: '0X10'. + self assert: node statements first value = 16 +! ! + +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +testFloat + | node | + scanner on: '0.1'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 0.1; + assert: node source = '0.1'. + scanner on: '0.1e-35'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 0.1e-35; + assert: node source = '0.1e-35' +! ! + +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +testInteger + | node | + scanner on: '0 12 -35'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 0; + assert: node source = '0'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 12; + assert: node source = '12'. + node := scanner next. + self + deny: node isNumberNode; + assert: (node is: #'-'); + assert: node source = '-'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 35; + assert: node source = '35' +! ! + +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +testIntegerRadix + | node | + scanner on: '16rFA2'. + node := scanner next. + self + assert: node isNumberNode; + assert: node value = 16rFA2; + assert: node source = '16rFA2' +! ! + +!SmalltalkScannerTest methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:41'! +testArrayStart + | node | + scanner on: '#()'. + node := scanner next. + self + assert: (node is: #'#('); + assert: node source = '#('. + scanner on: '#['. + node := scanner next. + self + assert: (node is: #'#['); + assert: node source = '#['. + scanner on: '#''hello'''. + node := scanner next. + self + assert: node value = #hello; + assert: node source = '#''hello''' +! ! + +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +testBinary + | node | + scanner on: '- + -- + --- + ==> + ~!!|\/%&*+=><'. + node := scanner next. + self + assert: node isBinary; + assert: node value = #'-'; + assert: node source = '-'. + node := scanner next. + self + assert: node isBinary; + assert: node value = #'--'; + assert: node source = '--'. + node := scanner next. + self + assert: node isBinary; + assert: node value = #'---'; + assert: node source = '---'. + node := scanner next. + self + assert: node isBinary; + assert: node value = #'==>'; + assert: node source = '==>'. + node := scanner next. + self + assert: node isBinary; + assert: node value = #'~!!|\/%&*+=><'; + assert: node source = '~!!|\/%&*+=><' +! ! + +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +testCharacter + | node | + scanner on: '$a$b'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = $a; + assert: node source = '$a'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = $b; + assert: node source = '$b' +! ! + +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +testEmpty + scanner on: ''. + self assert: scanner next isEnd +! ! + +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +testString + | node quote | + scanner on: '' storeString. + node := scanner next. + self + assert: node isLiteral; + assert: node value = ''; + assert: node source = (String with: $' with: $'). + scanner on: 'Hello World!!' storeString. + node := scanner next. + self + assert: node isLiteral; + assert: node value = 'Hello World!!'; + assert: node source = 'Hello World!!' storeString. + quote := String with: $'. + scanner on: quote storeString. + node := scanner next. + self + assert: node isLiteral; + assert: node value = quote; + assert: node source = quote storeString +! ! + +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +testBinarySymbol + | node | + scanner on: '#='. + node := scanner next. + self + assert: node isLiteral; + assert: node hasSymbol; + assert: node value = #'=' +! ! + +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +testDashStartingSymbol + | node | + scanner on: '#++'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'++'; + assert: node source = '#++'. + scanner on: '#//'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'//'; + assert: node source = '#//'. + scanner on: '#--'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'--'; + assert: node source = '#--'. + scanner on: '#+-'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'+-'; + assert: node source = '#+-' +! ! + +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +testNumericSymbol + scanner on: '#35'. + self assert: scanner next value = '35' asSymbol +! ! + +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +testSymbol + | node | + scanner on: '#-'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'-'; + assert: node source = '#-'. + scanner on: '#a:'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #a:; + assert: node source = '#a:'. + scanner on: '#-!!'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #'-!!'; + assert: node source = '#-!!'. + scanner on: '#a:b:'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #a:b:; + assert: node source = '#a:b:'. + scanner on: '#a:b'. + node := scanner next. + self + assert: node isLiteral; + assert: node value = #a:; + assert: node source = '#a:'. + node := scanner next. + self assert: node value = 'b'; assert: node source = 'b' +! ! + +!SmalltalkScannerTest methodsFor: 'colons' stamp: 'KenD 28/Jun/2026 13:27:41'! +testColon + | node | + scanner on: ':a'. + node := scanner next. + self + assert: (node is: $:); + assert: node source = ':'. + node := scanner next. + self + assert: node value = 'a'; + assert: node source = 'a'. + scanner on: ':='. + node := scanner next. + self + assert: node isAssignment; + assert: node source = ':=' +! ! + +!SmalltalkScannerTest methodsFor: 'colons' stamp: 'KenD 28/Jun/2026 13:27:41'! +testColon2 + | node | + scanner on: '::'. + node := scanner next. + self + assert: node class = SStringToken; + assert: node source = '::' +! ! + +!SmalltalkScannerTest methodsFor: 'comments' stamp: 'KenD 28/Jun/2026 13:27:41'! +testComment + | node | + scanner on: '"comment"a'. + node := scanner next. + self + assert: node isComment; + assert: node value = 'comment'; + assert: node source = '"comment"'. + scanner on: '"comment"'. + node := scanner next. + self + assert: node isComment; + assert: node source = '"comment"'; + assert: node position = 1. + scanner on: 'a"comment"'. + node := scanner next. + self + assert: node isNameToken; + assert: node value = 'a'; + assert: node source = 'a'. + node := scanner next. + self + assert: node isComment; + assert: node position = ('a' size + 1) +! ! + +!SmalltalkScannerTest methodsFor: 'identifiers' stamp: 'KenD 28/Jun/2026 13:27:41'! +testIdentifier + | node | + scanner on: 'a'. + node := scanner next. + self + assert: node isNameToken; + assert: node value = 'a'; + assert: node source = 'a'. + scanner on: ' a1'. + node := scanner next. + self + assert: node isNameToken; + assert: node value = 'a1'; + assert: node source = 'a1'. + scanner on: '_a'. + node := scanner next. + self + assert: node isNameToken; + assert: node value = '_a'; + assert: node source = '_a'. + scanner on: 'a_1b'. + node := scanner next. + self + assert: node isNameToken; + assert: node value = 'a_1b'; + assert: node source = 'a_1b' +! ! + +!SmalltalkScannerTest methodsFor: 'identifiers' stamp: 'KenD 28/Jun/2026 13:27:41'! +testKeyword + | node node2 | + scanner on: 'a:'. + node := scanner next. + self + assert: node isKeyword; + assert: node value = 'a:'; + assert: node source = 'a:'. + scanner on: 'ab:cd:'. + node := scanner next. + node2 := scanner next. + self + assert: node isKeyword; + assert: node value = 'ab:'; + assert: node source = 'ab:'; + assert: node2 isKeyword; + assert: node2 value = 'cd:'; + assert: node2 source = 'cd:' +! ! + +!SmalltalkScannerTest methodsFor: 'unicode' stamp: 'KenD 28/Jun/2026 13:27:41'! +testUnicodeScanning + "#knownIssue: depends on Character class>>value: path that resolves UnicodeLibrary, + which is not yet defined in the egg Kernel. Re-enable once UnicodeLibrary is ported." + | next three tensor | + #knownIssue. + self assert: false. + scanner on: '3 + 4' asWideString. + self assert: scanner next value = 3. + next := scanner next. + self + assert: next value == #'+'; + assert: scanner next value = 4. + scanner on: '3' asWideString , 8855 asCharacter asString , '4' asWideString. + three := scanner next. + self assert: three value = 3. + tensor := scanner next. + self assert: tensor value = 8855 asCharacter asString asSymbol +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_cachedLookup: aSymbol + ^self _cachedLookup: aSymbol in: self behavior +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_cachedLookup: aSymbol in: behavior + ^GlobalDispatchCache current lookupAndCache: aSymbol in: behavior +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_invoke: aNativeCode + " + senders of _invoke: MUST have at least 1 temporary. The argument of + _invoke: is removed twice: once here and once again after returning from + _invoke. If no temps are present, the second pop smashes the compiled + method of the frame, which happens to be in the top of the stack. This + would only be noticed by random crashes when executing debuggable + methods (because they send a message after _invoke: and before returning) + " + ^self _transferControlDiscardingLastArgTo: aNativeCode +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_lookup: aSymbol + ^self _lookup: aSymbol in: self behavior +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_lookup: aSymbol in: behavior + | methods cm next | + methods := behavior _basicAt: 2. + cm := self _lookup: aSymbol inDictionary: methods. + cm == nil ifFalse: [^cm]. + next := behavior _basicAt: 3. + ^next == nil ifFalse: [self _lookup: aSymbol in: next] +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +_lookup: aSymbol inDictionary: methodDictionary + | table | + table := methodDictionary _basicAt: 2. + 2 + to: table _size + by: 2 + do: [:j | (table _basicAt: j) == aSymbol ifTrue: [^table _basicAt: j + 1]]. + ^nil +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +lookupAndInvoke: aSymbol + | cm | + cm := self _cachedLookup: aSymbol. + cm == nil ifTrue: [^self doesNotUnderstandSelector: aSymbol]. + cm prepareForExecution. + self _transferControlDiscardingLastArgTo: cm validNativeCodeAddress _asNative +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_flagsMask: mask + self _basicFlags: (self _basicFlags bitAnd: mask) +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_flagsSet: mask + self _basicFlags: (self _basicFlags bitOr: mask) +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_hasBeenSeen + ^(self _basicFlags bitAnd: HasBeenSeen) == HasBeenSeen +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_hasNamedSlots + ^(self _basicFlags bitAnd: IsNamed) = IsNamed +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_headerSizeInBytes + ^self _isSmall ifTrue: [8] ifFalse: [16] +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isArrayed + ^false == self _isFixed +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isBytes + ^(self _basicFlags bitAnd: IsBytes) = IsBytes +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isFixed + ^(self _basicFlags bitAnd: IsArrayed) == 0 +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isLarge + ^(self _basicFlags bitAnd: IsSmall) == 0 +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isProxy + ^self _hasBeenSeen +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isRemembered + ^(self _basicFlags bitAnd: IsRemembered) = IsRemembered +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isSecondGeneration + ^(self _basicFlags bitAnd: IsSecondGeneration) = IsSecondGeneration +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isSmall + ^(self _basicFlags bitAnd: IsSmall) = IsSmall +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_isSpecial + ^(self _basicFlags bitAnd: IsSpecial) = IsSpecial +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_largeSize: size + self _basicULongAt: _ExtendedSize put: size _asNative +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_makeExtendedSize: size + self + _beLarge; + _smallSize: 4; + _largeSize: size; + _basicULongAt: _Reserved put: 0 _asNative +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_nextBasePointer + ^self _asPointer + self _sizeInBytes _asPointer +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_objectFromBasePointer + | offset | + offset := (self _asObject _byteAt: 4) > 127 ifTrue: [8] ifFalse: [16]. + ^(self + offset _asPointer) _asObject +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_pointersSize + ^self _isBytes ifTrue: [0] ifFalse: [self _size] +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_sizeInBytes + | total | + total := self _size. + ^self _isBytes + ifTrue: [total + WordSize - 1 bitAnd: 0 - WordSize] + ifFalse: [total * WordSize] +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_strongPointersSize + ^(self _isBytes or: [self _isSpecial]) ifTrue: [0] ifFalse: [0 + self _size] +! ! + +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +initializeExtended: aBoolean contentSize: size + self _basicULongAt: -1 put: 0 _asNative. + aBoolean + ifTrue: [ + self + _smallSize: 4; + _basicULongAt: _ExtendedSize put: size _asNative; + _basicULongAt: _Reserved put: 0 _asNative] + ifFalse: [self _smallSize: size; _beSmall] +! ! + +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_highHalf + ^self _oop bitShift: WordSize * 8 // -2 +! ! + +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_low32 + ^WordSize > 4 ifTrue: [self bitAnd: 0xFFFFFFFF] ifFalse: [self] +! ! + +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_lowHalf + ^self _oop bitAnd: 16rFFFF +! ! + +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +_oop + ^self _asPointer * 2 +! ! + +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +smallOop + ^self _asPointer +! ! + +!LMRProtoObject methodsFor: 'raw access' stamp: 'KenD 28/Jun/2026 13:27:38'! +_uLongAtValidOffset: offset put: anInteger + anInteger size > 4 ifTrue: [self error: 'does not fit in 32 bits']. + self _primitiveULongAtOffset: offset put: anInteger. + ^anInteger +! ! + +!LMRProtoObject methodsFor: 'unwinding' stamp: 'KenD 28/Jun/2026 13:27:38'! +_returnTo: aBeeFrame + [#forceEnvironment]. + aBeeFrame _beCurrent. + ^self +! ! + +!LMRProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +allReferences + ^Memory current collectAndCompactOldSpace; referencesTo: self +! ! + +!LMRProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +perform: aSymbol withArguments: anArray + | size | + size := anArray basicSize. + aSymbol arity = size ifFalse: [^self error: 'incorrect arity']. + anArray _expandInStackSized: size. + ^self lookupAndInvoke: aSymbol +! ! + +!LMRProtoObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +become: anotherObject + Memory current make: self become: anotherObject +! ! + +!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +doesNotUnderstandSelector: selector + | arguments message | + arguments := StackFrameCursor top moveNext + argumentsWithArity: selector arity. + message := Message receiver: self selector: selector arguments: arguments. + ^self doesNotUnderstand: message +! ! + +!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +holdRefererIfNeeded: referent + | memory | + #savePreviousSelf. + self _isSmallInteger ifTrue: [^self]. + referent _isRemembered ifTrue: [^self]. + memory := Memory current. + (memory isYoungSafe: referent) + ifFalse: [(memory isYoungSafe: self) ifTrue: [memory remember: referent]] +! ! + +!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +shouldBeInRememberedSet + | m | + m := Memory current. + (m isYoung: self) ifTrue: [^false]. + (m isYoung: self behavior) ifTrue: [^true]. + 1 to: self _pointersSize do: [:index | | ivar | + ivar := self _basicAt: index. + ivar _isSmallInteger ifFalse: [(m isYoung: ivar) ifTrue: [^true]]]. + ^false +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +allocate: byteSize size: size + | headerSize totalSize buffer object extended | + extended := size > 255. + headerSize := extended ifTrue: [16] ifFalse: [8]. + totalSize := headerSize + byteSize. + buffer := self memory allocate: totalSize. + object := (buffer + headerSize _asPointer) _asObject. + object + _basicULongAt: _Behavior put: self instanceBehavior; + initializeExtended: extended contentSize: size. + ^object +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew + ^self _instancesAreArrayed + ifTrue: [self primitiveNew: 0] + ifFalse: [self primitiveNew]! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +basicNew: anInteger + ^self primitiveNew: anInteger +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +memory + ^Memory current +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +new + ^self _instancesAreArrayed + ifTrue: [self primitiveNew: 0] + ifFalse: [self primitiveNew] +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +new: anInteger + ^self primitiveNew: anInteger +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNew + ^self memory newPointers: instanceBehavior size: self instSize +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNew: size + size _isSmallInteger ifFalse: [self error: 'invalid size']. + self _instancesAreArrayed ifFalse: [self errorNotIndexable]. + ^self _instancesHavePointers + ifTrue: [self primitiveNewPointers: size + self instSize] + ifFalse: [self primitiveNewBytes: size] +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNewBytes: size + ^self memory newArrayedBytes: instanceBehavior size: size +! ! + +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +primitiveNewPointers: size + ^self memory + newArrayedPointers: instanceBehavior + size: size + named: self instSize > 0 +! ! + +!LMRSpecies methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +nil: size slotsOf: object + object _nilSlots: size +! ! + +!LMRSpecies methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +zero: size bytesOf: object + object _zeroSlots: (size bitShift: 0 - WordSizeShift) +! ! +SFFIDescriptor initialize! From b74bdfb8764049626809a1c7d2af07cd857e30ad Mon Sep 17 00:00:00 2001 From: KenDickey Date: Wed, 1 Jul 2026 15:30:49 -0700 Subject: [PATCH 6/6] egg compiler update --- Cuis/Powerlang.pck.st | 27198 +++++++++++++++++++++++++++++----------- 1 file changed, 20025 insertions(+), 7173 deletions(-) diff --git a/Cuis/Powerlang.pck.st b/Cuis/Powerlang.pck.st index 3be4a21c..76c7e7e1 100644 --- a/Cuis/Powerlang.pck.st +++ b/Cuis/Powerlang.pck.st @@ -1,12 +1,12 @@ -'From Cuis7.9 [latest update: #7998] on 30 June 2026 at 8:34:53 am'! +'From Cuis7.9 [latest update: #8037] on 1 July 2026 at 3:21:12 pm'! 'Description Selected https://github.com/powerlang/egg/module classes transliterated via Cuis-Smalltalk-Tonel-Browser.'! -!provides: 'Powerlang' 1 3! +!provides: 'Powerlang' 1 14! !requires: 'BeeCompatibility' 1 65 nil! !requires: 'ExchangeFormat-Tonel-Lite' 1 73 nil! -SystemOrganization addCategory: 'Powerlang-ModuleSpecReader'! -SystemOrganization addCategory: 'Powerlang-CodeSpecs'! -SystemOrganization addCategory: 'Powerlang-ArgParser'! -SystemOrganization addCategory: 'Powerlang-EPM'! +SystemOrganization addCategory: #'Powerlang-ModuleSpecReader'! +SystemOrganization addCategory: #'Powerlang-CodeSpecs'! +SystemOrganization addCategory: #'Powerlang-ArgParser'! +SystemOrganization addCategory: #'Powerlang-EPM'! SystemOrganization addCategory: #'Powerlang-Core-LMR'! SystemOrganization addCategory: #'Powerlang-Core-SCompiler'! SystemOrganization addCategory: #'Powerlang-Core-SCompiler-Bindings'! @@ -15,8 +15,55 @@ SystemOrganization addCategory: #'Powerlang-Core-SCompiler-Smalltalk-Parser'! SystemOrganization addCategory: #'Powerlang-Core-SExpressions'! SystemOrganization addCategory: #'Powerlang-Kernel'! SystemOrganization addCategory: #'Powerlang-ModuleImporter'! -SystemOrganization addCategory: 'Powerlang-Compiler.Tests'! +SystemOrganization addCategory: #'Powerlang-Compiler.Tests'! +SystemOrganization addCategory: #'Powerlang-Writer'! +SystemOrganization addCategory: #'Powerlang-ImageSegmentBuilder'! +SystemOrganization addCategory: #'Powerlang-Nativization'! +SystemOrganization addCategory: #'Powerlang-Core-Building'! +SystemOrganization addCategory: #'Powerlang-Core-Assembly'! +SystemOrganization addCategory: #'Powerlang-Nativization-Assembly'! +SystemOrganization addCategory: #'Powerlang-Nativization-Tests'! + + +!classDefinition: #HashTable category: #'Powerlang-Kernel'! +Array variableSubclass: #HashTable + instanceVariableNames: 'policy' + classVariableNames: 'NilToken Sizes' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'HashTable class' category: #'Powerlang-Kernel'! +HashTable class + instanceVariableNames: 'NilToken Sizes'! + +!classDefinition: #InlinedHashTable category: #'Powerlang-Kernel'! +HashTable variableSubclass: #InlinedHashTable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'InlinedHashTable class' category: #'Powerlang-Kernel'! +InlinedHashTable class + instanceVariableNames: ''! +!classDefinition: #OpenHashTable category: #'Powerlang-Kernel'! +HashTable variableSubclass: #OpenHashTable + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'OpenHashTable class' category: #'Powerlang-Kernel'! +OpenHashTable class + instanceVariableNames: ''! + +!classDefinition: #OrderedHashTable category: #'Powerlang-Kernel'! +OpenHashTable variableSubclass: #OrderedHashTable + instanceVariableNames: 'values' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'OrderedHashTable class' category: #'Powerlang-Kernel'! +OrderedHashTable class + instanceVariableNames: ''! !classDefinition: #SFFIDescriptor category: #'Powerlang-Core-SCompiler'! ByteArray variableByteSubclass: #SFFIDescriptor @@ -88,6 +135,16 @@ CharacterArray subclass: #LMRCharacterArray LMRCharacterArray class instanceVariableNames: ''! +!classDefinition: #InlinedDictionary category: #'Powerlang-Kernel'! +Dictionary subclass: #InlinedDictionary + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'InlinedDictionary class' category: #'Powerlang-Kernel'! +InlinedDictionary class + instanceVariableNames: ''! + !classDefinition: #Namespace category: #'Powerlang-Kernel'! Dictionary subclass: #Namespace instanceVariableNames: 'parent' @@ -108,6 +165,16 @@ Dictionary subclass: #WeakIdentityDictionary WeakIdentityDictionary class instanceVariableNames: ''! +!classDefinition: #HashedCollection category: #'Powerlang-Kernel'! +Collection subclass: #HashedCollection + instanceVariableNames: 'tally table' + classVariableNames: 'Policies' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'HashedCollection class' category: #'Powerlang-Kernel'! +HashedCollection class + instanceVariableNames: 'Policies'! + !classDefinition: #SCompilationError category: #'Powerlang-Core-SCompiler'! Error subclass: #SCompilationError instanceVariableNames: 'compiler resumable retryable stretch' @@ -138,96 +205,206 @@ SCompilationError subclass: #SUndeclaredIdentifierError SUndeclaredIdentifierError class instanceVariableNames: ''! -!classDefinition: #ArgParser category: 'Powerlang-ArgParser'! +!classDefinition: #StackOverflow category: #'Powerlang-Kernel'! +Error subclass: #StackOverflow + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'StackOverflow class' category: #'Powerlang-Kernel'! +StackOverflow class + instanceVariableNames: ''! + +!classDefinition: #LMRFloat category: #'Powerlang-Kernel'! +Float subclass: #LMRFloat + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRFloat class' category: #'Powerlang-Kernel'! +LMRFloat class + instanceVariableNames: ''! + +!classDefinition: #ScaledDecimal category: #'Powerlang-Kernel'! +Fraction subclass: #ScaledDecimal + instanceVariableNames: 'scale' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'ScaledDecimal class' category: #'Powerlang-Kernel'! +ScaledDecimal class + instanceVariableNames: ''! + +!classDefinition: #ArgParser category: #'Powerlang-ArgParser'! Object subclass: #ArgParser instanceVariableNames: 'name description commands globalOptions' classVariableNames: '' poolDictionaries: '' category: 'Powerlang-ArgParser'! -!classDefinition: 'ArgParser class' category: 'Powerlang-ArgParser'! +!classDefinition: 'ArgParser class' category: #'Powerlang-ArgParser'! ArgParser class instanceVariableNames: ''! -!classDefinition: #Command category: 'Powerlang-ArgParser'! +!classDefinition: #Command category: #'Powerlang-ArgParser'! Object subclass: #Command instanceVariableNames: 'name description options positionalNames action subcommands' classVariableNames: '' poolDictionaries: '' category: 'Powerlang-ArgParser'! -!classDefinition: 'Command class' category: 'Powerlang-ArgParser'! +!classDefinition: 'Command class' category: #'Powerlang-ArgParser'! Command class instanceVariableNames: ''! -!classDefinition: #Option category: 'Powerlang-ArgParser'! +!classDefinition: #Option category: #'Powerlang-ArgParser'! Object subclass: #Option instanceVariableNames: 'short long description required hasValue defaultValue' classVariableNames: '' poolDictionaries: '' category: 'Powerlang-ArgParser'! -!classDefinition: 'Option class' category: 'Powerlang-ArgParser'! +!classDefinition: 'Option class' category: #'Powerlang-ArgParser'! Option class instanceVariableNames: ''! -!classDefinition: #ParseResult category: 'Powerlang-ArgParser'! +!classDefinition: #ParseResult category: #'Powerlang-ArgParser'! Object subclass: #ParseResult instanceVariableNames: 'command positionals options' classVariableNames: '' poolDictionaries: '' category: 'Powerlang-ArgParser'! -!classDefinition: 'ParseResult class' category: 'Powerlang-ArgParser'! +!classDefinition: 'ParseResult class' category: #'Powerlang-ArgParser'! ParseResult class instanceVariableNames: ''! -!classDefinition: #MethodSpec category: 'Powerlang-CodeSpecs'! +!classDefinition: #MethodSpec category: #'Powerlang-CodeSpecs'! Object subclass: #MethodSpec instanceVariableNames: 'selector class source category module ast' classVariableNames: '' poolDictionaries: '' category: 'Powerlang-CodeSpecs'! -!classDefinition: 'MethodSpec class' category: 'Powerlang-CodeSpecs'! +!classDefinition: 'MethodSpec class' category: #'Powerlang-CodeSpecs'! MethodSpec class instanceVariableNames: ''! -!classDefinition: #ModuleSpec category: 'Powerlang-CodeSpecs'! +!classDefinition: #ModuleSpec category: #'Powerlang-CodeSpecs'! Object subclass: #ModuleSpec instanceVariableNames: 'name description classes extendedClasses subclassifiedClasses imports dependencies' classVariableNames: '' poolDictionaries: '' category: 'Powerlang-CodeSpecs'! -!classDefinition: 'ModuleSpec class' category: 'Powerlang-CodeSpecs'! +!classDefinition: 'ModuleSpec class' category: #'Powerlang-CodeSpecs'! ModuleSpec class instanceVariableNames: ''! -!classDefinition: #SpeciesSpec category: 'Powerlang-CodeSpecs'! +!classDefinition: #SpeciesSpec category: #'Powerlang-CodeSpecs'! Object subclass: #SpeciesSpec instanceVariableNames: 'instanceVariables methods module format' classVariableNames: '' poolDictionaries: '' category: 'Powerlang-CodeSpecs'! -!classDefinition: 'SpeciesSpec class' category: 'Powerlang-CodeSpecs'! +!classDefinition: 'SpeciesSpec class' category: #'Powerlang-CodeSpecs'! SpeciesSpec class instanceVariableNames: ''! -!classDefinition: #ClassSpec category: 'Powerlang-CodeSpecs'! +!classDefinition: #ClassSpec category: #'Powerlang-CodeSpecs'! SpeciesSpec subclass: #ClassSpec instanceVariableNames: 'name supername classVariables sharedPools metaclass variable pointers' classVariableNames: '' poolDictionaries: '' category: 'Powerlang-CodeSpecs'! -!classDefinition: 'ClassSpec class' category: 'Powerlang-CodeSpecs'! +!classDefinition: 'ClassSpec class' category: #'Powerlang-CodeSpecs'! ClassSpec class instanceVariableNames: ''! -!classDefinition: #MetaclassSpec category: 'Powerlang-CodeSpecs'! +!classDefinition: #MetaclassSpec category: #'Powerlang-CodeSpecs'! SpeciesSpec subclass: #MetaclassSpec instanceVariableNames: 'class' classVariableNames: '' poolDictionaries: '' category: 'Powerlang-CodeSpecs'! -!classDefinition: 'MetaclassSpec class' category: 'Powerlang-CodeSpecs'! +!classDefinition: 'MetaclassSpec class' category: #'Powerlang-CodeSpecs'! MetaclassSpec class instanceVariableNames: ''! +!classDefinition: #Assembler category: #'Powerlang-Core-Assembly'! +Object subclass: #Assembler + instanceVariableNames: 'labels literals' + classVariableNames: 'IndexedLabels' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!classDefinition: 'Assembler class' category: #'Powerlang-Core-Assembly'! +Assembler class + instanceVariableNames: 'IndexedLabels'! + +!classDefinition: #GenericAssembler category: #'Powerlang-Core-Assembly'! +Assembler subclass: #GenericAssembler + instanceVariableNames: 'codegen' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!classDefinition: 'GenericAssembler class' category: #'Powerlang-Core-Assembly'! +GenericAssembler class + instanceVariableNames: ''! + +!classDefinition: #CodeGenerator category: #'Powerlang-Core-Assembly'! +Object subclass: #CodeGenerator + instanceVariableNames: 'abi wordSize memory' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!classDefinition: 'CodeGenerator class' category: #'Powerlang-Core-Assembly'! +CodeGenerator class + instanceVariableNames: ''! + +!classDefinition: #RISCCodeGenerator category: #'Powerlang-Core-Assembly'! +CodeGenerator subclass: #RISCCodeGenerator + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!classDefinition: 'RISCCodeGenerator class' category: #'Powerlang-Core-Assembly'! +RISCCodeGenerator class + instanceVariableNames: ''! + +!classDefinition: #NativeCodeReference category: #'Powerlang-Core-Assembly'! +Object subclass: #NativeCodeReference + instanceVariableNames: 'source sourceOffset target absolute' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!classDefinition: 'NativeCodeReference class' category: #'Powerlang-Core-Assembly'! +NativeCodeReference class + instanceVariableNames: ''! + +!classDefinition: #RelocatableBuffer category: #'Powerlang-Core-Assembly'! +Object subclass: #RelocatableBuffer + instanceVariableNames: 'stream address fixups' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!classDefinition: 'RelocatableBuffer class' category: #'Powerlang-Core-Assembly'! +RelocatableBuffer class + instanceVariableNames: ''! + +!classDefinition: #RelocationFixup category: #'Powerlang-Core-Assembly'! +Object subclass: #RelocationFixup + instanceVariableNames: 'source target relative size' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Assembly'! +!classDefinition: 'RelocationFixup class' category: #'Powerlang-Core-Assembly'! +RelocationFixup class + instanceVariableNames: ''! + +!classDefinition: #LookupNativizer category: #'Powerlang-Core-Building'! +Object subclass: #LookupNativizer + instanceVariableNames: 'nativizer methods' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-Building'! +!classDefinition: 'LookupNativizer class' category: #'Powerlang-Core-Building'! +LookupNativizer class + instanceVariableNames: ''! + !classDefinition: #IdentifierBinder category: #'Powerlang-Core-SCompiler'! Object subclass: #IdentifierBinder instanceVariableNames: 'contents' @@ -748,9925 +925,22455 @@ SSymbolicToken subclass: #SStringToken SStringToken class instanceVariableNames: ''! -!classDefinition: #Config category: 'Powerlang-EPM'! -Object subclass: #Config - instanceVariableNames: 'project user merged' +!classDefinition: #SBinding category: #'Powerlang-Core-SExpressions'! +Object subclass: #SBinding + instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-EPM'! -!classDefinition: 'Config class' category: 'Powerlang-EPM'! -Config class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SBinding class' category: #'Powerlang-Core-SExpressions'! +SBinding class instanceVariableNames: ''! -!classDefinition: #ProjectGenerator category: 'Powerlang-EPM'! -Object subclass: #ProjectGenerator - instanceVariableNames: 'name dir' +!classDefinition: #SAssociationBinding category: #'Powerlang-Core-SExpressions'! +SBinding subclass: #SAssociationBinding + instanceVariableNames: 'index association' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-EPM'! -!classDefinition: 'ProjectGenerator class' category: 'Powerlang-EPM'! -ProjectGenerator class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SAssociationBinding class' category: #'Powerlang-Core-SExpressions'! +SAssociationBinding class instanceVariableNames: ''! -!classDefinition: #LMRObject category: #'Powerlang-Kernel'! -Object subclass: #LMRObject +!classDefinition: #SDynamicBinding category: #'Powerlang-Core-SExpressions'! +SBinding subclass: #SDynamicBinding + instanceVariableNames: 'name cache' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SDynamicBinding class' category: #'Powerlang-Core-SExpressions'! +SDynamicBinding class + instanceVariableNames: ''! + +!classDefinition: #SNestedDynamicBinding category: #'Powerlang-Core-SExpressions'! +SDynamicBinding subclass: #SNestedDynamicBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'LMRObject class' category: #'Powerlang-Kernel'! -LMRObject class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SNestedDynamicBinding class' category: #'Powerlang-Core-SExpressions'! +SNestedDynamicBinding class instanceVariableNames: ''! -!classDefinition: #Module category: #'Powerlang-Kernel'! -Object subclass: #Module - instanceVariableNames: 'name version exports namespace hash cachedLookups classes extensions overriden requires' +!classDefinition: #SInstVarBinding category: #'Powerlang-Core-SExpressions'! +SBinding subclass: #SInstVarBinding + instanceVariableNames: 'index' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'Module class' category: #'Powerlang-Kernel'! -Module class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SInstVarBinding class' category: #'Powerlang-Core-SExpressions'! +SInstVarBinding class instanceVariableNames: ''! -!classDefinition: #ArgParserModule category: 'Powerlang-ArgParser'! -Module subclass: #ArgParserModule +!classDefinition: #SLiteralBinding category: #'Powerlang-Core-SExpressions'! +SBinding subclass: #SLiteralBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-ArgParser'! -!classDefinition: 'ArgParserModule class' category: 'Powerlang-ArgParser'! -ArgParserModule class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SLiteralBinding class' category: #'Powerlang-Core-SExpressions'! +SLiteralBinding class instanceVariableNames: ''! -!classDefinition: #CodeSpecsModule category: 'Powerlang-CodeSpecs'! -Module subclass: #CodeSpecsModule +!classDefinition: #SFalseBinding category: #'Powerlang-Core-SExpressions'! +SLiteralBinding subclass: #SFalseBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-CodeSpecs'! -!classDefinition: 'CodeSpecsModule class' category: 'Powerlang-CodeSpecs'! -CodeSpecsModule class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SFalseBinding class' category: #'Powerlang-Core-SExpressions'! +SFalseBinding class instanceVariableNames: ''! -!classDefinition: #TestsModule category: 'Powerlang-Compiler.Tests'! -Module subclass: #TestsModule +!classDefinition: #SNilBinding category: #'Powerlang-Core-SExpressions'! +SLiteralBinding subclass: #SNilBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Compiler.Tests'! -!classDefinition: 'TestsModule class' category: 'Powerlang-Compiler.Tests'! -TestsModule class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SNilBinding class' category: #'Powerlang-Core-SExpressions'! +SNilBinding class instanceVariableNames: ''! -!classDefinition: #CompilerModule category: #'Powerlang-Core-LMR'! -Module subclass: #CompilerModule - instanceVariableNames: '' +!classDefinition: #SLocalBinding category: #'Powerlang-Core-SExpressions'! +SBinding subclass: #SLocalBinding + instanceVariableNames: 'position environment' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Core-LMR'! -!classDefinition: 'CompilerModule class' category: #'Powerlang-Core-LMR'! -CompilerModule class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SLocalBinding class' category: #'Powerlang-Core-SExpressions'! +SLocalBinding class instanceVariableNames: ''! -!classDefinition: #EPMModule category: 'Powerlang-EPM'! -Module subclass: #EPMModule - instanceVariableNames: 'args parser config' +!classDefinition: #SArgumentBinding category: #'Powerlang-Core-SExpressions'! +SLocalBinding subclass: #SArgumentBinding + instanceVariableNames: 'inlined' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-EPM'! -!classDefinition: 'EPMModule class' category: 'Powerlang-EPM'! -EPMModule class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SArgumentBinding class' category: #'Powerlang-Core-SExpressions'! +SArgumentBinding class instanceVariableNames: ''! -!classDefinition: #LMRModule category: #'Powerlang-Kernel'! -Module subclass: #LMRModule +!classDefinition: #STemporaryBinding category: #'Powerlang-Core-SExpressions'! +SLocalBinding subclass: #STemporaryBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'LMRModule class' category: #'Powerlang-Kernel'! -LMRModule class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'STemporaryBinding class' category: #'Powerlang-Core-SExpressions'! +STemporaryBinding class instanceVariableNames: ''! -!classDefinition: #ModuleImporterModule category: #'Powerlang-ModuleImporter'! -Module subclass: #ModuleImporterModule +!classDefinition: #SSelfBinding category: #'Powerlang-Core-SExpressions'! +SBinding subclass: #SSelfBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-ModuleImporter'! -!classDefinition: 'ModuleImporterModule class' category: #'Powerlang-ModuleImporter'! -ModuleImporterModule class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SSelfBinding class' category: #'Powerlang-Core-SExpressions'! +SSelfBinding class instanceVariableNames: ''! -!classDefinition: #NumberParser category: #'Powerlang-Kernel'! -Object subclass: #NumberParser - instanceVariableNames: 'stream error return' +!classDefinition: #SSuperBinding category: #'Powerlang-Core-SExpressions'! +SSelfBinding subclass: #SSuperBinding + instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'NumberParser class' category: #'Powerlang-Kernel'! -NumberParser class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SSuperBinding class' category: #'Powerlang-Core-SExpressions'! +SSuperBinding class instanceVariableNames: ''! -!classDefinition: #ObjectReference category: #'Powerlang-Kernel'! -Object subclass: #ObjectReference - instanceVariableNames: 'source sourceOffset target absolute' +!classDefinition: #SExpression category: #'Powerlang-Core-SExpressions'! +Object subclass: #SExpression + instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'ObjectReference class' category: #'Powerlang-Kernel'! -ObjectReference class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SExpression class' category: #'Powerlang-Core-SExpressions'! +SExpression class instanceVariableNames: ''! -!classDefinition: #Species category: #'Powerlang-Kernel'! -Object subclass: #Species - instanceVariableNames: 'superclass instanceBehavior format organization instanceVariables' - classVariableNames: 'Flags' +!classDefinition: #SAssignment category: #'Powerlang-Core-SExpressions'! +SExpression subclass: #SAssignment + instanceVariableNames: 'assignees expression' + classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'Species class' category: #'Powerlang-Kernel'! -Species class - instanceVariableNames: 'Flags'! + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SAssignment class' category: #'Powerlang-Core-SExpressions'! +SAssignment class + instanceVariableNames: ''! -!classDefinition: #StarToken category: #'Powerlang-Kernel'! -Object subclass: #StarToken - instanceVariableNames: '' +!classDefinition: #SCascade category: #'Powerlang-Core-SExpressions'! +SExpression subclass: #SCascade + instanceVariableNames: 'receiver messages' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'StarToken class' category: #'Powerlang-Kernel'! -StarToken class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SCascade class' category: #'Powerlang-Core-SExpressions'! +SCascade class instanceVariableNames: ''! -!classDefinition: #Stretch category: #'Powerlang-Kernel'! -Object subclass: #Stretch - instanceVariableNames: 'start end' +!classDefinition: #SCascadeMessage category: #'Powerlang-Core-SExpressions'! +SExpression subclass: #SCascadeMessage + instanceVariableNames: 'selector arguments cascade cache' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'Stretch class' category: #'Powerlang-Kernel'! -Stretch class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SCascadeMessage class' category: #'Powerlang-Core-SExpressions'! +SCascadeMessage class instanceVariableNames: ''! -!classDefinition: #StringPattern category: #'Powerlang-Kernel'! -Object subclass: #StringPattern - instanceVariableNames: 'stream tokens' +!classDefinition: #SIdentifier category: #'Powerlang-Core-SExpressions'! +SExpression subclass: #SIdentifier + instanceVariableNames: 'binding' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'StringPattern class' category: #'Powerlang-Kernel'! -StringPattern class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SIdentifier class' category: #'Powerlang-Core-SExpressions'! +SIdentifier class instanceVariableNames: ''! -!classDefinition: #Unicode category: #'Powerlang-Kernel'! -Object subclass: #Unicode - instanceVariableNames: '' +!classDefinition: #SLiteralVar category: #'Powerlang-Core-SExpressions'! +SExpression subclass: #SLiteralVar + instanceVariableNames: 'index' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'Unicode class' category: #'Powerlang-Kernel'! -Unicode class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SLiteralVar class' category: #'Powerlang-Core-SExpressions'! +SLiteralVar class instanceVariableNames: ''! -!classDefinition: #UTF16 category: #'Powerlang-Kernel'! -Unicode subclass: #UTF16 - instanceVariableNames: '' +!classDefinition: #SLiteral category: #'Powerlang-Core-SExpressions'! +SLiteralVar subclass: #SLiteral + instanceVariableNames: 'value' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'UTF16 class' category: #'Powerlang-Kernel'! -UTF16 class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SLiteral class' category: #'Powerlang-Core-SExpressions'! +SLiteral class instanceVariableNames: ''! -!classDefinition: #UTF32 category: #'Powerlang-Kernel'! -Unicode subclass: #UTF32 - instanceVariableNames: '' +!classDefinition: #SMessage category: #'Powerlang-Core-SExpressions'! +SExpression subclass: #SMessage + instanceVariableNames: 'selector receiver arguments cache inlined' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'UTF32 class' category: #'Powerlang-Kernel'! -UTF32 class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SMessage class' category: #'Powerlang-Core-SExpressions'! +SMessage class instanceVariableNames: ''! -!classDefinition: #UTF8 category: #'Powerlang-Kernel'! -Unicode subclass: #UTF8 +!classDefinition: #SOperation category: #'Powerlang-Core-SExpressions'! +SExpression subclass: #SOperation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'UTF8 class' category: #'Powerlang-Kernel'! -UTF8 class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOperation class' category: #'Powerlang-Core-SExpressions'! +SOperation class instanceVariableNames: ''! -!classDefinition: #ModuleLoader category: #'Powerlang-ModuleImporter'! -Object subclass: #ModuleLoader - instanceVariableNames: 'module spec' +!classDefinition: #SInlinerOperation category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SInlinerOperation + instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-ModuleImporter'! -!classDefinition: 'ModuleLoader class' category: #'Powerlang-ModuleImporter'! -ModuleLoader class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SInlinerOperation class' category: #'Powerlang-Core-SExpressions'! +SInlinerOperation class instanceVariableNames: ''! -!classDefinition: #NameOfSubclass category: #'Powerlang-ModuleImporter'! -Object subclass: #NameOfSubclass - instanceVariableNames: '' +!classDefinition: #SOpJump category: #'Powerlang-Core-SExpressions'! +SInlinerOperation subclass: #SOpJump + instanceVariableNames: 'target' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-ModuleImporter'! -!classDefinition: 'NameOfSubclass class' category: #'Powerlang-ModuleImporter'! -NameOfSubclass class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpJump class' category: #'Powerlang-Core-SExpressions'! +SOpJump class instanceVariableNames: ''! -!classDefinition: #ModuleSpecReader category: 'Powerlang-ModuleSpecReader'! -Object subclass: #ModuleSpecReader - instanceVariableNames: 'module path metadata' +!classDefinition: #SOpJumpFalse category: #'Powerlang-Core-SExpressions'! +SOpJump subclass: #SOpJumpFalse + instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-ModuleSpecReader'! -!classDefinition: 'ModuleSpecReader class' category: 'Powerlang-ModuleSpecReader'! -ModuleSpecReader class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpJumpFalse class' category: #'Powerlang-Core-SExpressions'! +SOpJumpFalse class instanceVariableNames: ''! -!classDefinition: #MessageInlinerTest category: 'Powerlang-Compiler.Tests'! -TestCase subclass: #MessageInlinerTest +!classDefinition: #SOpJumpTrue category: #'Powerlang-Core-SExpressions'! +SOpJump subclass: #SOpJumpTrue instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Compiler.Tests'! -!classDefinition: 'MessageInlinerTest class' category: 'Powerlang-Compiler.Tests'! -MessageInlinerTest class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpJumpTrue class' category: #'Powerlang-Core-SExpressions'! +SOpJumpTrue class instanceVariableNames: ''! -!classDefinition: #SmalltalkScannerTest category: 'Powerlang-Compiler.Tests'! -TestCase subclass: #SmalltalkScannerTest - instanceVariableNames: 'scanner' +!classDefinition: #SOpLoadRfromFrame category: #'Powerlang-Core-SExpressions'! +SInlinerOperation subclass: #SOpLoadRfromFrame + instanceVariableNames: 'index' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Compiler.Tests'! -!classDefinition: 'SmalltalkScannerTest class' category: 'Powerlang-Compiler.Tests'! -SmalltalkScannerTest class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpLoadRfromFrame class' category: #'Powerlang-Core-SExpressions'! +SOpLoadRfromFrame class instanceVariableNames: ''! -!classDefinition: #LMRClosure category: #'Powerlang-Kernel'! -ProtoObject subclass: #LMRClosure +!classDefinition: #SOpPopR category: #'Powerlang-Core-SExpressions'! +SInlinerOperation subclass: #SOpPopR instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'LMRClosure class' category: #'Powerlang-Kernel'! -LMRClosure class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpPopR class' category: #'Powerlang-Core-SExpressions'! +SOpPopR class instanceVariableNames: ''! -!classDefinition: #LMRProtoObject category: #'Powerlang-Kernel'! -ProtoObject subclass: #LMRProtoObject - instanceVariableNames: '' +!classDefinition: #SOpStoreRintoFrame category: #'Powerlang-Core-SExpressions'! +SInlinerOperation subclass: #SOpStoreRintoFrame + instanceVariableNames: 'index' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'LMRProtoObject class' category: #'Powerlang-Kernel'! -LMRProtoObject class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpStoreRintoFrame class' category: #'Powerlang-Core-SExpressions'! +SOpStoreRintoFrame class instanceVariableNames: ''! -!classDefinition: #LMRSpecies category: #'Powerlang-Kernel'! -ProtoObject subclass: #LMRSpecies - instanceVariableNames: '' +!classDefinition: #SOpAssign category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpAssign + instanceVariableNames: 'assignees' classVariableNames: '' poolDictionaries: '' - category: 'Powerlang-Kernel'! -!classDefinition: 'LMRSpecies class' category: #'Powerlang-Kernel'! -LMRSpecies class + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpAssign class' category: #'Powerlang-Core-SExpressions'! +SOpAssign class instanceVariableNames: ''! +!classDefinition: #SOpDispatchMessage category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpDispatchMessage + instanceVariableNames: 'message' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpDispatchMessage class' category: #'Powerlang-Core-SExpressions'! +SOpDispatchMessage class + instanceVariableNames: ''! -!LMRArrayedCollection commentStamp: '' prior: 0! -Copyright (c) 2023, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #SOpDropToS category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpDropToS + instanceVariableNames: 'count' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpDropToS class' category: #'Powerlang-Core-SExpressions'! +SOpDropToS class + instanceVariableNames: ''! -!LMRSymbol commentStamp: '' prior: 0! -Copyright (c) 2022, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #SOpLoadRfromStack category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpLoadRfromStack + instanceVariableNames: 'index' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpLoadRfromStack class' category: #'Powerlang-Core-SExpressions'! +SOpLoadRfromStack class + instanceVariableNames: ''! -!WideSymbol commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!classDefinition: #SOpLoadRwithNil category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpLoadRwithNil + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpLoadRwithNil class' category: #'Powerlang-Core-SExpressions'! +SOpLoadRwithNil class + instanceVariableNames: ''! -!WideString commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!classDefinition: #SOpLoadRwithSelf category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpLoadRwithSelf + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpLoadRwithSelf class' category: #'Powerlang-Core-SExpressions'! +SOpLoadRwithSelf class + instanceVariableNames: ''! -!LMRCharacterArray commentStamp: '' prior: 0! -Copyright (c) 2023, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #SOpPrimitive category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpPrimitive + instanceVariableNames: 'block' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpPrimitive class' category: #'Powerlang-Core-SExpressions'! +SOpPrimitive class + instanceVariableNames: ''! -!Namespace commentStamp: '' prior: 0! -Copyright (c) 2022 Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #SOpPushR category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpPushR + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpPushR class' category: #'Powerlang-Core-SExpressions'! +SOpPushR class + instanceVariableNames: ''! -!WeakIdentityDictionary commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!classDefinition: #SOpRestart category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpRestart + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpRestart class' category: #'Powerlang-Core-SExpressions'! +SOpRestart class + instanceVariableNames: ''! -!ArgParser commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #SOpReturn category: #'Powerlang-Core-SExpressions'! +SOperation subclass: #SOpReturn + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpReturn class' category: #'Powerlang-Core-SExpressions'! +SOpReturn class + instanceVariableNames: ''! -!Command commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #SPragma category: #'Powerlang-Core-SExpressions'! +SExpression subclass: #SPragma + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SPragma class' category: #'Powerlang-Core-SExpressions'! +SPragma class + instanceVariableNames: ''! -!Option commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #SReturn category: #'Powerlang-Core-SExpressions'! +SExpression subclass: #SReturn + instanceVariableNames: 'local expression' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SReturn class' category: #'Powerlang-Core-SExpressions'! +SReturn class + instanceVariableNames: ''! -!ParseResult commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #SScript category: #'Powerlang-Core-SExpressions'! +SExpression subclass: #SScript + instanceVariableNames: 'statements compiledCode' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SScript class' category: #'Powerlang-Core-SExpressions'! +SScript class + instanceVariableNames: ''! -!MethodSpec commentStamp: '' prior: 0! -Copyright (c) 2024 Quorum Software. - See (MIT) license in root directory. -! +!classDefinition: #SBlock category: #'Powerlang-Core-SExpressions'! +SScript subclass: #SBlock + instanceVariableNames: 'index capturedVariables inlinedArgs' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SBlock class' category: #'Powerlang-Core-SExpressions'! +SBlock class + instanceVariableNames: ''! -!ModuleSpec commentStamp: '' prior: 0! -Copyright (c) 2024 Quorum Software. - See (MIT) license in root directory. -! +!classDefinition: #SMethod category: #'Powerlang-Core-SExpressions'! +SScript subclass: #SMethod + instanceVariableNames: 'pragma' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SMethod class' category: #'Powerlang-Core-SExpressions'! +SMethod class + instanceVariableNames: ''! -!SpeciesSpec commentStamp: '' prior: 0! -Copyright (c) 2024 Quorum Software. - See (MIT) license in root directory. -! +!classDefinition: #TreecodeDecoder category: #'Powerlang-Core-SExpressions'! +Object subclass: #TreecodeDecoder + instanceVariableNames: 'method stream builder' + classVariableNames: 'BindingTypes NodeTypes' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'TreecodeDecoder class' category: #'Powerlang-Core-SExpressions'! +TreecodeDecoder class + instanceVariableNames: 'BindingTypes NodeTypes'! -!ClassSpec commentStamp: '' prior: 0! -Copyright (c) 2024 Quorum Software. - See (MIT) license in root directory. -! +!classDefinition: #Config category: #'Powerlang-EPM'! +Object subclass: #Config + instanceVariableNames: 'project user merged' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-EPM'! +!classDefinition: 'Config class' category: #'Powerlang-EPM'! +Config class + instanceVariableNames: ''! -!MetaclassSpec commentStamp: '' prior: 0! -Copyright (c) 2024 Quorum Software. - See (MIT) license in root directory. -! +!classDefinition: #ProjectGenerator category: #'Powerlang-EPM'! +Object subclass: #ProjectGenerator + instanceVariableNames: 'name dir' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-EPM'! +!classDefinition: 'ProjectGenerator class' category: #'Powerlang-EPM'! +ProjectGenerator class + instanceVariableNames: ''! -!MessageInliner commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #Builder category: #'Powerlang-ImageSegmentBuilder'! +Object subclass: #Builder + instanceVariableNames: 'module closure classes' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ImageSegmentBuilder'! +!classDefinition: 'Builder class' category: #'Powerlang-ImageSegmentBuilder'! +Builder class + instanceVariableNames: ''! -!Config commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #ObjectClosure category: #'Powerlang-ImageSegmentBuilder'! +Object subclass: #ObjectClosure + instanceVariableNames: 'queue added objects mapping boundary scope builder nilToken reversePaths debug' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ImageSegmentBuilder'! +!classDefinition: 'ObjectClosure class' category: #'Powerlang-ImageSegmentBuilder'! +ObjectClosure class + instanceVariableNames: ''! -!ProjectGenerator commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #HashTablePolicy category: #'Powerlang-Kernel'! +Object subclass: #HashTablePolicy + instanceVariableNames: 'associationClass bucketClass maxSlots weak hasher comparison storesAssociations' + classVariableNames: 'EmptySlot' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'HashTablePolicy class' category: #'Powerlang-Kernel'! +HashTablePolicy class + instanceVariableNames: 'EmptySlot'! -!LMRObject commentStamp: '' prior: 0! -Copyright (c) 2024, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #ImageSegment category: #'Powerlang-Kernel'! +Object subclass: #ImageSegment + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'ImageSegment class' category: #'Powerlang-Kernel'! +ImageSegment class + instanceVariableNames: ''! -!Module commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!classDefinition: #LMRObject category: #'Powerlang-Kernel'! +Object subclass: #LMRObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRObject class' category: #'Powerlang-Kernel'! +LMRObject class + instanceVariableNames: ''! -!ArgParserModule commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #MatchAlgorithm category: #'Powerlang-Kernel'! +Object subclass: #MatchAlgorithm + instanceVariableNames: 'string pattern start stop tokens failure ranges' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'MatchAlgorithm class' category: #'Powerlang-Kernel'! +MatchAlgorithm class + instanceVariableNames: ''! -!CodeSpecsModule commentStamp: '' prior: 0! -Copyright (c) 2022, Quorum Software. - See (MIT) license in root directory. -! +!classDefinition: #MatchToken category: #'Powerlang-Kernel'! +Object subclass: #MatchToken + instanceVariableNames: 'string start stop' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'MatchToken class' category: #'Powerlang-Kernel'! +MatchToken class + instanceVariableNames: ''! -!TestsModule commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #Module category: #'Powerlang-Kernel'! +Object subclass: #Module + instanceVariableNames: 'name version exports namespace hash cachedLookups classes extensions overriden requires' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'Module class' category: #'Powerlang-Kernel'! +Module class + instanceVariableNames: ''! -!CompilerModule commentStamp: '' prior: 0! -Copyright (c) 2022, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #ArgParserModule category: #'Powerlang-ArgParser'! +Module subclass: #ArgParserModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ArgParser'! +!classDefinition: 'ArgParserModule class' category: #'Powerlang-ArgParser'! +ArgParserModule class + instanceVariableNames: ''! -!EPMModule commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #CodeSpecsModule category: #'Powerlang-CodeSpecs'! +Module subclass: #CodeSpecsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-CodeSpecs'! +!classDefinition: 'CodeSpecsModule class' category: #'Powerlang-CodeSpecs'! +CodeSpecsModule class + instanceVariableNames: ''! -!LMRModule commentStamp: '' prior: 0! -Copyright (c) 2024, Javier Pimás. - See (MIT) license in root directory. -! +!classDefinition: #TestsModule category: #'Powerlang-Compiler.Tests'! +Module subclass: #TestsModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Compiler.Tests'! +!classDefinition: 'TestsModule class' category: #'Powerlang-Compiler.Tests'! +TestsModule class + instanceVariableNames: ''! -!ModuleImporterModule commentStamp: '' prior: 0! +!classDefinition: #CompilerModule category: #'Powerlang-Core-LMR'! +Module subclass: #CompilerModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-LMR'! +!classDefinition: 'CompilerModule class' category: #'Powerlang-Core-LMR'! +CompilerModule class + instanceVariableNames: ''! + +!classDefinition: #LMRModule category: #'Powerlang-Core-LMR'! +Module subclass: #LMRModule + instanceVariableNames: 'globals memory' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-LMR'! +!classDefinition: 'LMRModule class' category: #'Powerlang-Core-LMR'! +LMRModule class + instanceVariableNames: ''! + +!classDefinition: #SExpressionsModule category: #'Powerlang-Core-LMR'! +Module subclass: #SExpressionsModule + instanceVariableNames: 'globals memory' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-LMR'! +!classDefinition: 'SExpressionsModule class' category: #'Powerlang-Core-LMR'! +SExpressionsModule class + instanceVariableNames: ''! + +!classDefinition: #EPMModule category: #'Powerlang-EPM'! +Module subclass: #EPMModule + instanceVariableNames: 'args parser config' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-EPM'! +!classDefinition: 'EPMModule class' category: #'Powerlang-EPM'! +EPMModule class + instanceVariableNames: ''! + +!classDefinition: #ImageSegmentBuilderModule category: #'Powerlang-ImageSegmentBuilder'! +Module subclass: #ImageSegmentBuilderModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ImageSegmentBuilder'! +!classDefinition: 'ImageSegmentBuilderModule class' category: #'Powerlang-ImageSegmentBuilder'! +ImageSegmentBuilderModule class + instanceVariableNames: ''! + +!classDefinition: #KernelModule category: #'Powerlang-Kernel'! +Module subclass: #KernelModule + instanceVariableNames: 'memory entrypoint loadedModules moduleLoaders host CRITICAL unhandledErrorHandler session properties utf8 utf16 utf32' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'KernelModule class' category: #'Powerlang-Kernel'! +KernelModule class + instanceVariableNames: ''! + +!classDefinition: #ModuleImporterModule category: #'Powerlang-ModuleImporter'! +Module subclass: #ModuleImporterModule + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ModuleImporter'! +!classDefinition: 'ModuleImporterModule class' category: #'Powerlang-ModuleImporter'! +ModuleImporterModule class + instanceVariableNames: ''! + +!classDefinition: #NativizerModule category: #'Powerlang-Nativization'! +Module subclass: #NativizerModule + instanceVariableNames: 'environment' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization'! +!classDefinition: 'NativizerModule class' category: #'Powerlang-Nativization'! +NativizerModule class + instanceVariableNames: ''! + +!classDefinition: #NumberParser category: #'Powerlang-Kernel'! +Object subclass: #NumberParser + instanceVariableNames: 'stream error return' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'NumberParser class' category: #'Powerlang-Kernel'! +NumberParser class + instanceVariableNames: ''! + +!classDefinition: #ObjectReference category: #'Powerlang-Kernel'! +Object subclass: #ObjectReference + instanceVariableNames: 'source sourceOffset target absolute' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'ObjectReference class' category: #'Powerlang-Kernel'! +ObjectReference class + instanceVariableNames: ''! + +!classDefinition: #SmalltalkSession category: #'Powerlang-Kernel'! +Object subclass: #SmalltalkSession + instanceVariableNames: 'name username args resources finalizer' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'SmalltalkSession class' category: #'Powerlang-Kernel'! +SmalltalkSession class + instanceVariableNames: ''! + +!classDefinition: #SmalltalkSystem category: #'Powerlang-Kernel'! +Object subclass: #SmalltalkSystem + instanceVariableNames: 'globals eventHandlers registeredEvents eventDispatcher' + classVariableNames: 'Implementors Senders' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'SmalltalkSystem class' category: #'Powerlang-Kernel'! +SmalltalkSystem class + instanceVariableNames: 'Implementors Senders'! + +!classDefinition: #Species category: #'Powerlang-Kernel'! +Object subclass: #Species + instanceVariableNames: 'superclass instanceBehavior format organization instanceVariables' + classVariableNames: 'Flags' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'Species class' category: #'Powerlang-Kernel'! +Species class + instanceVariableNames: 'Flags'! + +!classDefinition: #StarToken category: #'Powerlang-Kernel'! +Object subclass: #StarToken + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'StarToken class' category: #'Powerlang-Kernel'! +StarToken class + instanceVariableNames: ''! + +!classDefinition: #StringPattern category: #'Powerlang-Kernel'! +Object subclass: #StringPattern + instanceVariableNames: 'stream tokens' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'StringPattern class' category: #'Powerlang-Kernel'! +StringPattern class + instanceVariableNames: ''! + +!classDefinition: #Unicode category: #'Powerlang-Kernel'! +Object subclass: #Unicode + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'Unicode class' category: #'Powerlang-Kernel'! +Unicode class + instanceVariableNames: ''! + +!classDefinition: #UTF16 category: #'Powerlang-Kernel'! +Unicode subclass: #UTF16 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'UTF16 class' category: #'Powerlang-Kernel'! +UTF16 class + instanceVariableNames: ''! + +!classDefinition: #UTF32 category: #'Powerlang-Kernel'! +Unicode subclass: #UTF32 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'UTF32 class' category: #'Powerlang-Kernel'! +UTF32 class + instanceVariableNames: ''! + +!classDefinition: #UTF8 category: #'Powerlang-Kernel'! +Unicode subclass: #UTF8 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'UTF8 class' category: #'Powerlang-Kernel'! +UTF8 class + instanceVariableNames: ''! + +!classDefinition: #ModuleLoader category: #'Powerlang-ModuleImporter'! +Object subclass: #ModuleLoader + instanceVariableNames: 'module spec' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ModuleImporter'! +!classDefinition: 'ModuleLoader class' category: #'Powerlang-ModuleImporter'! +ModuleLoader class + instanceVariableNames: ''! + +!classDefinition: #NameOfSubclass category: #'Powerlang-ModuleImporter'! +Object subclass: #NameOfSubclass + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ModuleImporter'! +!classDefinition: 'NameOfSubclass class' category: #'Powerlang-ModuleImporter'! +NameOfSubclass class + instanceVariableNames: ''! + +!classDefinition: #ModuleSpecReader category: #'Powerlang-ModuleSpecReader'! +Object subclass: #ModuleSpecReader + instanceVariableNames: 'module path metadata' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-ModuleSpecReader'! +!classDefinition: 'ModuleSpecReader class' category: #'Powerlang-ModuleSpecReader'! +ModuleSpecReader class + instanceVariableNames: ''! + +!classDefinition: #InlinedMessageNativizer category: #'Powerlang-Nativization'! +Object subclass: #InlinedMessageNativizer + instanceVariableNames: 'message assembler nativizer start end' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization'! +!classDefinition: 'InlinedMessageNativizer class' category: #'Powerlang-Nativization'! +InlinedMessageNativizer class + instanceVariableNames: ''! + +!classDefinition: #MessageLinker category: #'Powerlang-Nativization'! +Object subclass: #MessageLinker + instanceVariableNames: 'filter' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization'! +!classDefinition: 'MessageLinker class' category: #'Powerlang-Nativization'! +MessageLinker class + instanceVariableNames: ''! + +!classDefinition: #InlineMessageLinker category: #'Powerlang-Nativization'! +MessageLinker subclass: #InlineMessageLinker + instanceVariableNames: 'assembler map' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization'! +!classDefinition: 'InlineMessageLinker class' category: #'Powerlang-Nativization'! +InlineMessageLinker class + instanceVariableNames: ''! + +!classDefinition: #InvokeLinker category: #'Powerlang-Nativization'! +MessageLinker subclass: #InvokeLinker + instanceVariableNames: 'invoker sends' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization'! +!classDefinition: 'InvokeLinker class' category: #'Powerlang-Nativization'! +InvokeLinker class + instanceVariableNames: ''! + +!classDefinition: #LookupLinker category: #'Powerlang-Nativization'! +MessageLinker subclass: #LookupLinker + instanceVariableNames: 'lookup lookupSuper' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization'! +!classDefinition: 'LookupLinker class' category: #'Powerlang-Nativization'! +LookupLinker class + instanceVariableNames: ''! + +!classDefinition: #LazyLinker category: #'Powerlang-Nativization'! +LookupLinker subclass: #LazyLinker + instanceVariableNames: 'sends' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization'! +!classDefinition: 'LazyLinker class' category: #'Powerlang-Nativization'! +LazyLinker class + instanceVariableNames: ''! + +!classDefinition: #NativizationEnvironment category: #'Powerlang-Nativization'! +Object subclass: #NativizationEnvironment + instanceVariableNames: 'platform optimizedMethods invokedMethods inlinedMethods messageLinker writeBarrier safepointCheck cachedNativizer busy' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization'! +!classDefinition: 'NativizationEnvironment class' category: #'Powerlang-Nativization'! +NativizationEnvironment class + instanceVariableNames: ''! + +!classDefinition: #NativizationPlatform category: #'Powerlang-Nativization'! +Object subclass: #NativizationPlatform + instanceVariableNames: 'name wordSize abi codeGeneratorClass' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization'! +!classDefinition: 'NativizationPlatform class' category: #'Powerlang-Nativization'! +NativizationPlatform class + instanceVariableNames: ''! + +!classDefinition: #ABI category: #'Powerlang-Nativization-Assembly'! +Object subclass: #ABI + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization-Assembly'! +!classDefinition: 'ABI class' category: #'Powerlang-Nativization-Assembly'! +ABI class + instanceVariableNames: ''! + +!classDefinition: #Writer category: #'Powerlang-Writer'! +Object subclass: #Writer + instanceVariableNames: 'stream objects mapping imports exports closure' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Writer'! +!classDefinition: 'Writer class' category: #'Powerlang-Writer'! +Writer class + instanceVariableNames: ''! + +!classDefinition: #MessageInlinerTest category: #'Powerlang-Compiler.Tests'! +TestCase subclass: #MessageInlinerTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Compiler.Tests'! +!classDefinition: 'MessageInlinerTest class' category: #'Powerlang-Compiler.Tests'! +MessageInlinerTest class + instanceVariableNames: ''! + +!classDefinition: #SmalltalkScannerTest category: #'Powerlang-Compiler.Tests'! +TestCase subclass: #SmalltalkScannerTest + instanceVariableNames: 'scanner' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Compiler.Tests'! +!classDefinition: 'SmalltalkScannerTest class' category: #'Powerlang-Compiler.Tests'! +SmalltalkScannerTest class + instanceVariableNames: ''! + +!classDefinition: #TemplateJITTest category: #'Powerlang-Nativization-Tests'! +TestCase subclass: #TemplateJITTest + instanceVariableNames: 'environment' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Nativization-Tests'! +!classDefinition: 'TemplateJITTest class' category: #'Powerlang-Nativization-Tests'! +TemplateJITTest class + instanceVariableNames: ''! + +!classDefinition: #SOpNonLocalReturn category: #'Powerlang-Core-SExpressions'! +ProtoObject subclass: #SOpNonLocalReturn + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Core-SExpressions'! +!classDefinition: 'SOpNonLocalReturn class' category: #'Powerlang-Core-SExpressions'! +SOpNonLocalReturn class + instanceVariableNames: ''! + +!classDefinition: #LMRClosure category: #'Powerlang-Kernel'! +ProtoObject subclass: #LMRClosure + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRClosure class' category: #'Powerlang-Kernel'! +LMRClosure class + instanceVariableNames: ''! + +!classDefinition: #LMRProtoObject category: #'Powerlang-Kernel'! +ProtoObject subclass: #LMRProtoObject + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRProtoObject class' category: #'Powerlang-Kernel'! +LMRProtoObject class + instanceVariableNames: ''! + +!classDefinition: #LMRSpecies category: #'Powerlang-Kernel'! +ProtoObject subclass: #LMRSpecies + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Powerlang-Kernel'! +!classDefinition: 'LMRSpecies class' category: #'Powerlang-Kernel'! +LMRSpecies class + instanceVariableNames: ''! + + +!HashTable commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!InlinedHashTable commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OpenHashTable commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!OrderedHashTable commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!LMRArrayedCollection commentStamp: '' prior: 0! +Copyright (c) 2023, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRSymbol commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!WideSymbol commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!WideString commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!LMRCharacterArray commentStamp: '' prior: 0! +Copyright (c) 2023, Javier Pimás. + See (MIT) license in root directory. +! + +!InlinedDictionary commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Namespace commentStamp: '' prior: 0! +Copyright (c) 2022 Javier Pimás. + See (MIT) license in root directory. +! + +!WeakIdentityDictionary commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!HashedCollection commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StackOverflow commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!LMRFloat commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!ScaledDecimal commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ArgParser commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!Command commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!Option commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!ParseResult commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!MethodSpec commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ModuleSpec commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!SpeciesSpec commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ClassSpec commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!MetaclassSpec commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!Assembler commentStamp: '' prior: 0! +I am the JIT assembler frontend. I provide a high-level assembler interface (if that really exists) +and delegate writing of the actual bytes to my backends. +! + +!GenericAssembler commentStamp: '' prior: 0! +I am a JIT GenericAssembler frontend that can generate code for different architectures +using different code generators. +! + +!RelocatableBuffer commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!RelocationFixup commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!MessageInliner commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!SExpression commentStamp: '' prior: 0! +I am a Smalltalk expression, the minimal unit of Smalltalk semantics, expressed as a tree +! + +!Config commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!ProjectGenerator commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!ObjectClosure commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!HashTablePolicy commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ImageSegment commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!LMRObject commentStamp: '' prior: 0! +Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!MatchAlgorithm commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!MatchToken commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Module commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ArgParserModule commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!CodeSpecsModule commentStamp: '' prior: 0! +Copyright (c) 2022, Quorum Software. + See (MIT) license in root directory. +! + +!TestsModule commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!CompilerModule commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRModule commentStamp: '' prior: 0! +Copyright (c) 2024, Javier Pimás. + See (MIT) license in root directory. +! + +!EPMModule commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!ImageSegmentBuilderModule commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!KernelModule commentStamp: '' prior: 0! +Copyright (c) 2022, Quorum Software. + Copyright (c) 2020, LabWare. + See (MIT) license in root directory. +! + +!ModuleImporterModule commentStamp: '' prior: 0! Copyright (c) 2022, Quorum Software. See (MIT) license in root directory. ! -!NumberParser commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!NativizerModule commentStamp: '' prior: 0! +Copyright (c) 2023, Javier Pimás. + See (MIT) license in root directory. +! + +!NumberParser commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ObjectReference commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!SmalltalkSystem commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Species commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StarToken commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!StringPattern commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!Unicode commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!UTF16 commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!UTF32 commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!UTF8 commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. +! + +!ModuleLoader commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ModuleSpecReader commentStamp: '' prior: 0! +Copyright (c) 2024 Quorum Software. + See (MIT) license in root directory. +! + +!ABI commentStamp: '' prior: 0! +Copyright (c) 2020 Aucerna. + See (MIT) license in root directory. + +`ABI` seems to serve two different purposes: + + i) provide support for calling (native) function with system + calling convention for given architecture and OS combination + +ii) provide fixed mapping from 'IR' registers (such as A, R, M and so on) + to real machine registers + +! + +!Writer commentStamp: '' prior: 0! +Copyright (c) 2022-2023, Javier Pimás. + See (MIT) license in root directory. +! + +!MessageInlinerTest commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!SmalltalkScannerTest commentStamp: '' prior: 0! +Copyright (c) 2026, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRClosure commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRProtoObject commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!LMRSpecies commentStamp: '' prior: 0! +Copyright (c) 2022, Javier Pimás. + See (MIT) license in root directory. +! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationClass + ^policy notNil ifTrue: [policy associationClass] ifFalse: [Association] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index put: anObject + | element | + element := anObject ifNil: [NilToken]. + ^self basicAt: index put: element +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +atKey: key hash: hash put: element + | index | + index := self indexOfKey: key hash: hash. + ^self at: index key: key put: element +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +beWeak + | empty | + empty := self emptySlot. + self withIndexDo: [:v :i | v isNil ifTrue: [self basicAt: i put: empty]]. + super beWeak +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bucketClass + ^OpenHashTable +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +clearSlots: indexes ifAbsent: absentBlock + | empty | + empty := self emptySlot. + indexes do: [:i | | v | + v := self at: i. + (v == nil or: [v == empty]) + ifTrue: [absentBlock value] + ifFalse: [self clearSlot: i with: empty]] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +emptySlot + ^policy notNil ifTrue: [policy emptySlot] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +equates: anObject1 with: anObject2 + ^policy notNil + ifTrue: [policy equates: anObject1 with: anObject2] + ifFalse: [anObject1 = anObject2] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hashFor: anObject + ^policy notNil ifTrue: [policy hashFor: anObject] ifFalse: [anObject hash] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexOf: key + | hash | + hash := self hashFor: key. + ^self indexOfHash: hash +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexOfHash: integer + ^integer \\ (self size // 2) + 1 +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexOfKey: key + | hash | + hash := self hashFor: key. + ^self indexOfKey: key hash: hash +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexOfKey: key hash: hash + | first empty | + first := self indexOfHash: hash. + empty := self emptySlot. + ^self + findFirst: [:obj | + obj == nil or: [obj == empty] or: [| k | + k := obj == NilToken ifFalse: [obj]. + self equates: key with: k]] + startingAt: first +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keyFor: anObject + ^policy notNil ifTrue: [policy keyFor: anObject] ifFalse: [anObject] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keyNotFound: anObject + KeyNotFound signalFor: anObject +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +rehash: indexes + | n index empty | + n := self size. + index := 1. + empty := self emptySlot. + indexes sort do: [:j | | v | + index := j max: index. + [ + index := index = n ifTrue: [1] ifFalse: [index + 1]. + v := self at: index. + v == nil or: [v == empty]] + whileFalse: [| k i | + k := self keyFor: v. + i := self indexOfKey: k. + v := self basicAt: i. + (v == nil or: [v == empty]) ifTrue: [self moveSlot: index to: i]]] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +rehashFrom: index1 to: index2 + | max empty n | + max := index2. + empty := self emptySlot. + n := self size. + self + withIndexDo: [:obj :i | | j v k | + i = n ifTrue: [max := 0]. + (obj == empty and: [i > max]) ifTrue: [^self]. + k := self keyFor: obj. + j := self indexOfKey: k. + v := self basicAt: j. + (v == nil or: [v == empty]) ifTrue: [self moveSlot: i to: j]] + startingAt: index1 +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeAll + 1 to: self size do: [:i | self basicAt: i put: nil] +! ! + +!HashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeKeys: keys ifAbsent: absentBlock + | indexes min max | + keys isEmpty ifTrue: [^self]. + min := self size + 1. + max := 0. + indexes := keys + collect: [:k | | index | + index := self indexOfKey: k. + index < min ifTrue: [min := index]. + max < index ifTrue: [max := index]. + index] + in: OrderedCollection new. + self clearSlots: indexes ifAbsent: absentBlock. + indexes size <= 1000 + ifTrue: [self rehash: indexes] + ifFalse: [self rehashFrom: min to: max] +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +atKey: key put: element + | hash | + hash := self hashFor: key. + ^self atKey: key hash: hash put: element +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +atKey: key sum: magnitude + | hash | + hash := self hashFor: key. + ^self atKey: key hash: hash sum: magnitude +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +findFirst: aBlock startingAt: index + | n i first slots | + n := self size. + first := i := index. + slots := self slotsPerElement. + [aBlock evaluateWith: (self at: i)] whileFalse: [ + i := i + slots. + i > n ifTrue: [i := 1]. + i = first ifTrue: [self error: 'element not found']]. + ^i +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +lookUpValue: key ifAbsent: aBlock ifPresent: pBlock + | v | + v := self lookupValue: key ifAbsent: [^aBlock value]. + ^pBlock arity = 1 ifTrue: [pBlock evaluateWith: v] ifFalse: [pBlock value] +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +lookupKey: key + ^self lookupKey: key ifAbsent: nil +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +lookupKey: key ifAbsent: aBlock + | index hash first empty | + hash := self hashFor: key. + first := self indexOfHash: hash. + empty := self emptySlot. + index := self + findFirst: [:obj | + obj == empty or: [| k | + k := obj == NilToken ifFalse: [obj]. + self equates: key with: k]] + startingAt: first. + ^self valueAt: index ifAbsent: aBlock +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +lookupValue: key ifAbsent: aBlock + ^self lookupKey: key ifAbsent: aBlock +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +lookupValue: key ifPresent: aBlock + ^self lookUpValue: key ifAbsent: nil ifPresent: aBlock +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +owner + ^policy +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +owner: aHashedCollection + policy := aHashedCollection +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +policy + ^policy +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +policy: aHashTablePolicy + policy := aHashTablePolicy +! ! + +!HashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +valueAt: index ifAbsent: aBlock + | value | + value := self at: index. + value == nil ifTrue: [^aBlock value]. + value == self emptySlot ifTrue: [^aBlock value]. + ^value == NilToken ifFalse: [value] +! ! + +!HashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +clearSlot: anInteger + self clearSlot: anInteger with: self emptySlot +! ! + +!HashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +clearSlot: anInteger with: emptySlot + self basicAt: anInteger put: emptySlot +! ! + +!HashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeKey: key ifAbsent: aBlock + | index empty object | + index := self indexOfKey: key. + empty := self emptySlot. + object := self basicAt: index. + object == nil ifTrue: [^aBlock value]. + object == empty ifTrue: [^aBlock value]. + self clearSlot: index. + index := index + self slotsPerElement. + index > self size ifTrue: [index := 1]. + self + withIndexDo: [:obj :i | | j v k | + obj == empty ifTrue: [^self]. + k := self keyFor: obj. + j := self indexOfKey: k. + v := self basicAt: j. + (v == nil or: [v == empty]) ifTrue: [self moveSlot: i to: j]] + startingAt: index +! ! + +!HashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +slotsPerElement + ^1 +! ! + +!HashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +withIndexDo: aBlock startingAt: anInteger + | n i first slots | + n := self size. + first := i := anInteger. + slots := self slotsPerElement. + [ + aBlock evaluateWith: (self at: i) with: i. + i := i + slots. + i > n ifTrue: [i := 1]. + i = first] whileFalse +! ! + +!HashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +elementsDo: aBlock + self elementsDo: aBlock count: self size +! ! + +!HashTable methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +replaceBackwardFrom: stop to: start with: aCollection startingAt: position + | i j | + i := stop. + j := position. + [start <= i] whileTrue: [ + self basicAt: i put: (aCollection at: j). + i := i - 1. + j := j - 1] +! ! + +!HashTable methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +replaceForwardFrom: start to: stop with: aCollection startingAt: position + | i j | + i := start. + j := position. + [i <= stop] whileTrue: [ + self basicAt: i put: (aCollection at: j). + i := i + 1. + j := j + 1] +! ! + +!HashTable class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initializeConstants + NilToken := Object new +! ! + +!HashTable class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initializeSizes + | primes p | + Sizes := ByteArray new: 126. + primes := #( + 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 + 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 + 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 + ) readStream. + p := primes next. + 1 to: Sizes size do: [:i | | n | + n := i * 2 - 1. + p < n ifTrue: [p := primes next]. + Sizes at: i put: p] +! ! + +!HashTable class methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +goodPrimes + " + from squeak + " + ^#(269 359 479 641 857 1151 1549 2069 + 2237 2423 2617 2797 2999 3167 3359 3539 3727 3911 + 4441 4787 5119 5471 5801 6143 6521 6827 7177 7517 7853 + 8783 9601 10243 10867 11549 12239 12919 13679 14293 15013 15731 + 17569 19051 20443 21767 23159 24611 25847 27397 28571 30047 31397 + 35771 38201 40841 43973 46633 48989 51631 54371 57349 60139 62969 + 70589 76091 80347 85843 90697 95791 101051 106261 111143 115777 120691 126311 + 140863 150523 160969 170557 181243 190717 201653 211891 221251 232591 242873 251443 + 282089 300869 321949 341227 362353 383681 401411 422927 443231 464951 482033 504011 + 562621 605779 647659 681607 723623 763307 808261 844709 886163 926623 967229 1014617 + 1121987 1201469 1268789 1345651 1429531 1492177 1577839 1651547 1722601 1800377 1878623 1942141 2028401 + 2242727 2399581 2559173 2686813 2836357 3005579 3144971 3283993 3460133 3582923 3757093 3903769 4061261 + 4455361 4783837 5068529 5418079 5680243 6000023 6292981 6611497 6884641 7211599 7514189 7798313 8077189 + 9031853 9612721 10226107 10745291 11338417 11939203 12567671 13212697 13816333 14337529 14938571 15595673 16147291 + 17851577 18993941 20180239 21228533 22375079 23450491 24635579 25683871 26850101 27921689 29090911 30153841 31292507 32467307 + 35817611 37983761 40234253 42457253 44750177 46957969 49175831 51442639 53726417 55954637 58126987 60365939 62666977 64826669 + 71582779 76039231 80534381 84995153 89500331 93956777 98470819 102879613 107400389 111856841 116365721 120819287 125246581 129732203 + 143163379 152076289 161031319 169981667 179000669 187913573 196826447 205826729 214748357 223713691 232679021 241591901 250504801 259470131 + 285162679 301939921 318717121 335494331 352271573 369148753 385926017 402603193 419480419 436157621 453034849 469712051 486589307 503366497 520043707 + 570475349 603929813 637584271 671138659 704693081 738247541 771801929 805356457 838910803 872365267 905919671 939574117 973128521 1006682977 1040137411 + 1073741833) +! ! + +!HashTable class methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +primeFor: size + | n primes | + n := size bitOr: 1. + n <= 251 ifTrue: [^Sizes at: n // 2 + 1]. + primes := self goodPrimes. + 1 to: primes size do: [:i | | p | + p := primes at: i. + p > n ifTrue: [^p]]. + ^n +! ! + +!HashTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new + ^self new: 7 +! ! + +!HashTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new: anInteger + | size | + size := self primeFor: anInteger. + ^super new: size +! ! + +!HashTable class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nilToken + ^NilToken +! ! + +!InlinedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index key: key put: element + (self at: index) ifNil: [ + self + at: index put: key; + at: index + 1 put: element. + ^nil]. + self at: index + 1 put: element. + ^key +! ! + +!InlinedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +atKey: key hash: hash sum: magnitude + | index v k | + index := self indexOfKey: key hash: hash. + k := self at: index. + (k == nil or: [k == self emptySlot]) ifFalse: [ + v := (self at: index + 1) + magnitude. + self at: index + 1 put: v. + ^v]. + self + at: index put: key; + at: index + 1 put: magnitude. + ^nil +! ! + +!InlinedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +count + | n empty | + n := 0. + empty := self emptySlot. + 1 to: self size by: 2 do: [:i | | k | + k := self at: i. + (k == nil or: [k == empty]) ifFalse: [n := n + 1]]. + ^n +! ! + +!InlinedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicAtKey: key put: element + | index | + index := self indexOfKey: key. + self + at: index put: key; + at: index + 1 put: element +! ! + +!InlinedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +copyFromBucket: bucket + | count | + count := 0. + bucket keysAndValuesDo: [:key :value | + count := count + 1. + self basicAtKey: key put: value]. + ^count +! ! + +!InlinedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexOfHash: integer + ^integer \\ (self size // 2) * 2 + 1 +! ! + +!InlinedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +lookupValue: key + ^self lookupValue: key ifAbsent: [self keyNotFound: key] +! ! + +!InlinedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +valueAt: index ifAbsent: aBlock + | k value | + k := self at: index. + (k == nil or: [k == self emptySlot]) ifTrue: [^aBlock value]. + value := self at: index + 1. + ^value == NilToken ifFalse: [value] +! ! + +!InlinedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +clearSlot: anInteger with: emptySlot + self + basicAt: anInteger put: emptySlot; + basicAt: anInteger + 1 put: emptySlot +! ! + +!InlinedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +moveSlot: anInteger to: targetInteger + | k v empty | + empty := self emptySlot. + k := self basicAt: anInteger. + v := self basicAt: anInteger + 1. + self + basicAt: anInteger put: empty; + basicAt: anInteger + 1 put: empty; + basicAt: targetInteger put: k; + basicAt: targetInteger + 1 put: v +! ! + +!InlinedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +slotsPerElement + ^2 +! ! + +!InlinedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +elementsDo: aBlock count: n + | count | + count := 0. + self keysAndValuesDo: [:k :v | | assoc | + assoc := Association key: k value: v. + aBlock evaluateWith: assoc. + count := count + 1. + count = n ifTrue: [^self]] +! ! + +!InlinedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keysAndValuesDo: aBlock + 1 to: self size by: 2 do: [:index | | key value | + key := self at: index. + key notNil ifTrue: [ + key := key == NilToken ifFalse: [key]. + value := self at: index + 1. + value := value == NilToken ifFalse: [value]. + aBlock value: key value: value]] +! ! + +!InlinedHashTable methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isCapacityGreaterThan: count + ^self size * 3 > (count * 8) +! ! + +!InlinedHashTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new: anInteger + | n | + n := self primeFor: anInteger. + ^self basicNew: n * 2 +! ! + +!OpenHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index key: key put: element + | object | + object := self at: index. + object == self emptySlot ifTrue: [object := nil]. + object == nil ifTrue: [self at: index put: element]. + ^object +! ! + +!OpenHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +atKey: key hash: hash sum: magnitude + | index object assoc sum | + index := self indexOfKey: key hash: hash. + object := self at: index. + (object == nil or: [object == self emptySlot]) ifTrue: [ + assoc := self associationClass key: key value: magnitude. + self at: index put: assoc. + ^nil]. + sum := object value + magnitude. + object value: sum. + ^object +! ! + +!OpenHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +count + ^self count: [:n | n notNil] +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicAtKey: key put: element + | index | + index := self indexOfKey: key. + self at: index put: element +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +copyAssociations + self + withIndexDo: [:a :index | a isAssociation + ifTrue: [self at: index put: a key -> a value]] +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +copyFromBucket: bucket + | count | + count := 0. + bucket elementsDo: [:element | | key | + count := count + 1. + key := self keyFor: element. + self basicAtKey: key put: element]. + ^count +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexOfHash: integer + ^integer \\ self size + 1 +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +lookupValue: key + ^self lookupValue: key ifAbsent: [self keyNotFound: key] +! ! + +!OpenHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +lookupValue: key ifAbsent: aBlock + | assoc | + assoc := super lookupValue: key ifAbsent: [^aBlock value]. + ^assoc value +! ! + +!OpenHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +elementsDo: aBlock count: n + | i empty | + n = 0 ifTrue: [^self]. + i := 0. + empty := self emptySlot. + 1 to: self size do: [:index | | value | + value := self at: index. + value == nil | (value == empty) ifFalse: [ + value := value == NilToken ifFalse: [value]. + aBlock evaluateWith: value. + i := i + 1. + i = n ifTrue: [^self]]] +! ! + +!OpenHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keysAndValuesDo: aBlock + self + elementsDo: [:assoc | aBlock evaluateWith: assoc key with: assoc value] +! ! + +!OpenHashTable methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isCapacityGreaterThan: count + ^self size * 75 > (count * 100) +! ! + +!OpenHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +moveSlot: anInteger to: targetInteger + | a | + a := self basicAt: anInteger. + self + basicAt: anInteger put: self emptySlot; + basicAt: targetInteger put: a +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index + | i | + i := super at: index. + i ifNil: [^nil]. + ^values at: i +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index put: anObject + | i element | + i := self basicAt: index. + element := anObject ifNil: [NilToken]. + (i == nil or: [i == self emptySlot]) + ifTrue: [ + values add: element. + super at: index put: values size] + ifFalse: [values at: i put: element]. + ^anObject +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +first + values do: [:v | v notNil ifTrue: [^v]]. + ^nil +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexOfElement: anObject + | i | + i := 1. + self elementsDo: [:assoc | + assoc value == anObject ifTrue: [^i]. + i := i + 1]. + ^0 +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +last + values reverseDo: [:v | v notNil ifTrue: [^v]]. + ^nil +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +totalSize + ^values size +! ! + +!OrderedHashTable methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +valueAt: index ifAbsent: aBlock + | i value | + i := self basicAt: index. + i == nil ifTrue: [^aBlock value]. + i == self emptySlot ifTrue: [^aBlock value]. + value := values at: i ifAbsent: [^aBlock value]. + ^value == NilToken ifFalse: [value] +! ! + +!OrderedHashTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index tally: tally + | n i count vi | + n := values size. + index * 2 <= n + ifTrue: [ + i := 1. + count := 0. + [ + vi := values at: i. + vi == nil ifFalse: [count := count + 1]. + count = index ifTrue: [^vi == NilToken ifFalse: [vi]]. + i := i + 1. + i <= n] whileTrue] + ifFalse: [ + i := n. + count := tally + 1. + [ + vi := values at: i. + vi == nil ifFalse: [count := count - 1]. + count = index ifTrue: [^vi == NilToken ifFalse: [vi]]. + i := i - 1. + 0 < i] whileTrue] +! ! + +!OrderedHashTable methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +compressTo: tally + | relocations compressed | + values size = tally ifTrue: [^self]. + relocations := Array new: values size. + compressed := OrderedCollection new: tally. + values withIndexDo: [:value :index | + value notNil ifTrue: [ + compressed add: value. + relocations at: index put: compressed size]]. + 1 to: self size do: [:index | | old new | + old := super at: index. + old notNil ifTrue: [ + new := relocations at: old. + super at: index put: new]]. + values := compressed +! ! + +!OrderedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +clearSlot: anInteger with: emptySlot + | i | + i := self basicAt: anInteger. + self basicAt: anInteger put: emptySlot. + values at: i put: emptySlot +! ! + +!OrderedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeAll + super removeAll. + values removeAll +! ! + +!OrderedHashTable methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeObject: anObject ifAbsent: aBlock + | association | + association := values + detect: [:assoc | assoc value == anObject] + ifNone: [^aBlock value]. + ^self removeKey: association key ifAbsent: aBlock +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +elementAt: index + ^values at: index +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +elementsDo: aBlock + values + select: [:value | value !!== nil] + thenDo: [:value | aBlock evaluateWith: (value == NilToken ifFalse: [value])] +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +elementsDo: aBlock count: n + | i | + n = 0 ifTrue: [^self]. + i := 0. + self elementsDo: [:value | + aBlock evaluateWith: value. + i := i + 1. + i = n ifTrue: [^self]] +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keysAndValuesDo: aBlock + self elementsDo: [:assoc | aBlock value: assoc key value: assoc value] +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +privateDo: aBlock + values do: [:value | aBlock evaluateWith: value] +! ! + +!OrderedHashTable methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +valuesReverseDo: aBlock + values reverseDo: [:assoc | + assoc == nil + ifFalse: [aBlock evaluateWith: (assoc == NilToken ifFalse: [assoc]) value]] +! ! + +!OrderedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexAtKey: key + | index | + index := self indexOfKey: key. + ^self basicAt: index +! ! + +!OrderedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +move: anAssociation to: anInteger + | a min max | + a := values indexOf: anAssociation. + min := a min: anInteger. + max := a max: anInteger. + 1 to: self size do: [:i | | index | + index := self basicAt: i. + index notNil ifTrue: [ + (index between: min and: max) ifTrue: [ + index <= a + ifTrue: [self basicAt: i put: index + 1] + ifFalse: [self basicAt: i put: index - 1]]. + index = a ifTrue: [self basicAt: i put: anInteger]]]. + values move: values last to: anInteger +! ! + +!OrderedHashTable methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +moveLastTo: anInteger + | last | + last := values size. + 1 to: self size do: [:i | | index | + index := self basicAt: i. + index notNil ifTrue: [ + index >= anInteger ifTrue: [self basicAt: i put: index + 1]. + index = last ifTrue: [self basicAt: i put: anInteger]]]. + values move: values last to: anInteger +! ! + +!OrderedHashTable methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initialize + super initialize. + values := OrderedCollection new +! ! + +!OrderedHashTable methodsFor: 'copying' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +postCopy + super postCopy. + values := values copy +! ! + +!OrderedHashTable class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new: anInteger + ^(super new: anInteger) initialize +! ! + +!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +arguments: aCollection + self replaceFrom: 1 to: aCollection size with: aCollection +! ! + +!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +callingConvention: anInteger + self at: self size put: anInteger +! ! + +!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +return: anInteger + self at: self size - 1 put: anInteger +! ! + +!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + self initializeFFITypes; initializeCallingConventions +! ! + +!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeCallingConventions + FFICallingConventions := Dictionary new. + FFICallingConventions + at: 'cdecl' put: 20; + at: 'com' put: 21; + at: 'callback' put: 22 +! ! + +!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeFFITypes + FFITypes := Dictionary new. + FFITypes + at: 'uint8' put: 0; + at: 'sint8' put: 1; + at: 'uint16' put: 2; + at: 'sint16' put: 3; + at: 'uint32' put: 4; + at: 'sint32' put: 5; + at: 'uint64' put: 6; + at: 'sint64' put: 7; + + at: 'float' put: 8; + at: 'double' put: 9; + + at: 'uchar' put: 10; + at: 'schar' put: 11; + at: 'ushort' put: 12; + at: 'sshort' put: 13; + at: 'ulong' put: 14; + at: 'slong' put: 15; + at: 'ularge' put: 16; + at: 'large' put: 17; + at: 'longdouble' put: 18; + at: 'pointer' put: 19; + at: 'complex-float' put: 20; + at: 'complex-double' put: 21; + at: 'complex-longdouble' put: 22; + + at: 'void' put: 23 +! ! + +!SFFIDescriptor class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ret: aString args: aCollection cc: ccName + | args return cc result | + args := aCollection + collect: [ :argname | + FFITypes + at: argname asString + ifAbsent: [ self error: 'undefined argument type ' , argname ] ]. + return := FFITypes + at: aString + ifAbsent: [ self error: 'undefined result type ' , aString ]. + cc := FFICallingConventions + at: ccName + ifAbsent: [ self error: 'unsupported calling convention ' , ccName ]. + result := self new: args size + 2. + ^ result + callingConvention: cc; + return: return; + arguments: args +! ! + +!LMRSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +flushCacheFor: species + GlobalDispatchCache current flush: self forSpecies: species. + SendSite flush: self +! ! + +!WideSymbol methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +<= aString + ^UTF16 current isString: self lessThanOrEqualTo: aString +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asByteCharacters + | n result | + n := self size. + result := Symbol new: n. + 1 to: n do: [:i | | code char | + code := self codeAt: i. + char := code < 256 ifTrue: [code] ifFalse: [$? asInteger]. + result byteAt: i put: char]. + ^result +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asLowercase + ^UTF16 current lowercaseOf: self +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asString + | n string | + n := self size. + string := WideString new: n. + ^string replaceFrom: 1 to: n with: self +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asUppercase + ^UTF16 current uppercaseOf: self +! ! + +!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asWideSymbol + ^self +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index + | cp | + cp := self checkIndex: index; codeAt: index. + ^Character value: cp +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index putCode: codePoint + ^self + checkIndex: index; + uLongAtOffset: index - 1 * 4 put: codePoint +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +atValid: index + | cp | + cp := self codeAt: index. + ^Character value: cp +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +size + ^self _size // 4 +! ! + +!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sizeInBytes + ^self size * 4 +! ! + +!WideSymbol methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicSize + ^self _size +! ! + +!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +codeAt: index + ^self uLongAtOffset: index - 1 * 4 +! ! + +!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +species + ^WideString +! ! + +!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +td1 + | m td1 | + m := self size. + td1 := Dictionary new: m. + m to: 1 by: -1 do: [:i | | code | + code := self uLongAtOffset: i - 1 * 4. + td1 at: code + 1 ifAbsentPut: [m - i + 1]]. + ^td1 +! ! + +!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isByteCompliant + ^false +! ! + +!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isWide + ^true +! ! + +!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isWideSymbol + ^true +! ! + +!WideSymbol class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +findInterned: aString + | symbol string | + string := aString reduced. + string == aString ifFalse: [^super findInterned: string]. + symbol := aString bytes changeClassTo: self. + ^SymbolTable lookup: symbol +! ! + +!WideSymbol class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +intern: aString + | symbol canonical | + aString isByteCompliant ifTrue: [^aString reduced asSymbol]. + symbol := aString bytes changeClassTo: self. + canonical := SymbolTable lookup: symbol. + canonical == nil ifTrue: [^SymbolTable add: symbol]. + ^canonical +! ! + +!WideString methodsFor: 'operations' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +, aString + | n string | + aString isString ifFalse: [^super , aString]. + n := self size. + string := WideString new: n + aString size. + ^string + replaceBytesFrom: 1 to: self sizeInBytes with: self startingAt: 1; + replaceFrom: n + 1 to: string size with: aString startingAt: 1 +! ! + +!WideString methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +<= aString + ^UTF16 current isString: self lessThanOrEqualTo: aString +! ! + +!WideString methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hash + | hash | + hash := self size. + 0 + to: self sizeInBytes - 4 + by: 4 + do: [:i | hash := (hash hashMultiply: 16r19660D) + bitXor: (self uLongAtOffset: i)]. + ^hash +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asByteCharacters + | n result | + n := self size. + result := String new: n. + 1 to: n do: [:i | | code char | + code := self codeAt: i. + char := code < 256 ifTrue: [code] ifFalse: [$? asInteger]. + result byteAt: i put: char]. + ^result +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asLowercase + ^UTF16 current lowercaseOf: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asSymbol + ^WideSymbol intern: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asUppercase + ^UTF16 current uppercaseOf: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asWideString + ^self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +existingSymbol + ^WideSymbol findInterned: self +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +reduced + ^self isByteCompliant ifTrue: [self asByteCharacters] ifFalse: [self] +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sizeInBytes + ^self basicSize +! ! + +!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +utf8Bytes + ^UTF8 current encode: self +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index + | cp | + cp := self checkIndex: index; codeAt: index. + ^Character value: cp +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index putCode: codePoint + ^self + checkIndex: index; + uLongAtOffset: index - 1 * 4 put: codePoint +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +atValid: index + | cp | + cp := self codeAt: index. + ^Character value: cp +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +atValid: anInteger put: aCharacter + self at: anInteger putCode: aCharacter codePoint. + ^aCharacter +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +atValid: index putCode: codePoint + ^self uLongAtOffset: index - 1 * 4 put: codePoint +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +checkByteIndex: index + index isInteger ifFalse: [self error: 'strings are indexed by integers']. + (index between: 1 and: self sizeInBytes) + ifFalse: [self + error: 'index: ' , index printString , ' is outside of string bounds'] +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +codeAt: index + ^self uLongAtOffset: index - 1 * 4 +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromCodePoints: aCollection + 1 to: aCollection size do: [:i | | ci | + ci := aCollection at: i. + self at: i putCode: ci] +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexAt: anInteger + ^anInteger +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +primitiveULongAtOffset: offset +put: anInteger + offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. + (0 <= offset and: [offset + 3 <= self _size]) + ifFalse: [^self outOfBoundsIndex: offset]. + ^self uLongAtValidOffset: offset put: anInteger +! ! + +!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +td1 + | m td1 | + m := self size. + td1 := Dictionary new: m. + m to: 1 by: -1 do: [:i | | code | + code := self codeAt: i. + td1 at: code + 1 ifAbsentPut: [m - i + 1]]. + ^td1 +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: anInteger put: aCharacter + self + checkCharacter: aCharacter; + at: anInteger putCode: aCharacter codePoint. + ^aCharacter +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicAt: anInteger + ^self basicByteAt: anInteger +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicAt: anInteger put: anObject + ^self basicByteAt: anInteger put: anObject +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicSize + ^self _size +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +byteAt: anInteger + anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= anInteger and: [anInteger <= self _size]) + ifFalse: [^self outOfBoundsIndex: anInteger]. + ^self _byteAt: anInteger +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +byteAt: position put: asciiValue + position _isSmallInteger ifFalse: [^self error: 'Non integer index']. + (1 <= position and: [position <= self _size]) + ifFalse: [^self outOfBoundsIndex: position]. + (0 <= asciiValue and: [asciiValue < 256]) + ifFalse: [^self error: 'invalid character']. + ^self _byteAt: position put: asciiValue +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +characterSize + ^4 +! ! + +!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +size + ^self basicSize // 4 +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +composeCharacters + ^UTF16 current compose: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decomposeCharacters + ^UTF16 current decompose: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +foldDigits + ^UTF16 current foldDigitsOf: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +normalizeToC + ^UTF16 current normalizeToC: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +normalizeToD + ^(UTF16 current normalizeToD: self) reduced +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +normalizeToKC + ^UTF16 current normalizeToKC: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +normalizeToKD + ^UTF16 current normalizeToKD: self +! ! + +!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +unaccented + ^self normalizeToD reject: [:ch | ch isNonSpacingMark] +! ! + +!WideString methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexOfString: aString from: start to: stop td1: anArray + | m k | + m := aString size. + m = 0 ifTrue: [^0]. + k := start. + [k + m - 1 <= stop] whileTrue: [| i code delta | + i := 1. + [i <= m and: [(aString at: i) = (self at: k + i - 1)]] + whileTrue: [i := i + 1]. + i > m ifTrue: [^k]. + k + m > stop ifTrue: [^0]. + code := self codeAt: k + m. + delta := anArray at: code + 1 ifAbsent: nil. + delta isNil ifTrue: [delta := m + 1]. + k := k + delta]. + ^0 +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isByteCompliant + 1 to: self size do: [:i | | char | + char := self at: i. + char isByteCharacter ifFalse: [^false]]. + ^true +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isCNormal + ^UTF16 current isCNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isDNormal + ^UTF16 current isDNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isKCNormal + ^UTF16 current isKCNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isKDNormal + ^UTF16 current isKDNormal: self +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isWide + ^true +! ! + +!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isWideString + ^true +! ! + +!WideString methodsFor: 'inquires' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +length + ^UTF16 current lengthOf: self +! ! + +!WideString methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +printChunkOn: aStream from: anInteger + ^self printUTF8ChunkOn: aStream from: anInteger +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +replace: anInteger with: aString + 1 to: anInteger do: [:i | | char | + char := aString at: i. + self at: i put: char] +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +replaceFirst: anInteger with: aString + 1 to: anInteger do: [:i | | char | + char := aString at: i. + self at: i put: char] +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +replaceFrom: start to: stop with: aString startingAt: position + | string | + string := self replacementFrom: aString. + super + replaceFrom: start - 1 * 4 + 1 + to: stop * 4 + with: string + startingAt: position - 1 * 4 + 1 +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +replaceFrom: start to: stop withObject: aCharacter + self checkIndex: start; checkIndex: stop. + start to: stop do: [:i | self at: i put: aCharacter] +! ! + +!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +replacementFrom: aString + | n wide | + aString class == self class ifTrue: [^aString]. + aString isExternalMemory ifTrue: [^WideString fromMemory: aString]. + n := aString size. + wide := WideString new: n. + 1 to: n do: [:i | | ch | + ch := aString atValid: i. + wide atValid: i put: ch]. + ^wide +! ! + +!WideString methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +uLongAtValidOffset: offset put: anInteger + anInteger size > 4 ifTrue: [self error: 'does not fit in 32 bits']. + self _uLongAtOffset: offset put: anInteger. + ^anInteger +! ! + +!WideString class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicNew: anInteger + ^self primitiveNewBytes: anInteger +! ! + +!WideString class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new: anInteger + ^self basicNew: anInteger * 4 +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromBytes: aByteArray + ^UTF16 current + decodeStringFrom: aByteArray readStream + on: (self new: aByteArray size) +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromCodePoints: aCollection + | string | + string := self new: aCollection size. + ^string fromCodePoints: aCollection +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromExternalUTF16: anExternalMemory + ^UTF16 current decodeStringFrom: anExternalMemory readStream +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromExternalUTF16: anExternalMemory length: anInteger + | stream | + stream := anExternalMemory readStream. + stream readLimit: anInteger. + ^UTF16 current decodeStringFrom: stream +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromExternalUTF8: anExternalMemory + ^UTF8 current decodeStringFrom: anExternalMemory readStream +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromMemory: anExternalMemory + | s i | + s := self new: 1. + i := 1. + [ + s replaceBytesFrom: 1 to: 2 with: anExternalMemory startingAt: i. + (s codeAt: 1) = 0] + whileFalse: [i := i + 2]. + ^self fromMemory: anExternalMemory length: i - 1 // 2 +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromMemory: anExternalMemory length: anInteger + | bytes | + bytes := anExternalMemory readStream readLimit: anInteger * 2. + ^UTF16 current decodeStringFrom: bytes on: (self new: anInteger) +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromMultiByte: aByteArray codePage: anInteger + " + WideString fromMultiByte: #[16rFA] codePage: 1251 + " + | bytes string | + bytes := aByteArray externalCopy. + string := self + fromMultiByteAddress: bytes + codePage: anInteger + size: aByteArray sizeInBytes. + bytes free. + ^string +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromString: aString + aString class == String ifTrue: [^aString asWideString]. + aString class == self ifTrue: [^aString]. + ^self fromUTF8: aString asString utf8 +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromUTF8: aByteArray + ^UTF8 current + decodeStringFrom: aByteArray readStream + on: (self new: aByteArray size) +! ! + +!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +stringFromMemory: anExternalMemory + | s i | + s := self new: 1. + i := 1. + [ + s replaceBytesFrom: 1 to: 2 with: anExternalMemory startingAt: i. + (s codeAt: 1) = 0] + whileFalse: [i := i + 2]. + ^UTF16 decodeFromAddress: anExternalMemory length: i - 1 // 2 +! ! + +!WideString class methodsFor: 'gs' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +newFrom: aByteArray + ^aByteArray copy changeClassTo: self +! ! + +!WideString class methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +stringsFromAddress: anExternalMemory + | strings memory | + strings := OrderedCollection new. + memory := anExternalMemory. + [(memory at: 1) = 0 and: [(memory at: 2) = 0]] whileFalse: [| s | + s := self stringFromMemory: memory. + strings add: s. + memory := memory + (s size + 1 * 2)]. + ^strings +! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 29/Jun/2026, 7:12:21 pm (UTC)'! +dosToUnix + ^self species streamContents: [:s | | source | + source := self readStream. + [source atEnd] whileFalse: [| c | + c := source next. + (c = `Character cr`) + ifTrue: [ + s nextPut: `Character lf`. + source next] + ifFalse: [s nextPut: c]]]! ! + +!CharacterArray methodsFor: 'converting' stamp: 'KenD 29/Jun/2026, 7:11:33 pm (UTC)'! +unixToMac + | result | + result := self species new: self size. + self + withIndexDo: [:c :i | (c = `Character lf`) + ifTrue: [result at: i put: `Character cr`] + ifFalse: [result at: i put: c]]. + ^result! ! + +!LMRCharacterArray methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +primitiveSize + ^self _size +! ! + +!InlinedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationAt: key ifAbsent: exceptionBlock + | value | + value := table lookupValue: key ifAbsent: [^exceptionBlock value]. + ^self associationClass key: key value: value +! ! + +!InlinedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: key put: element + (table atKey: key put: element) == nil ifTrue: [self incrementTally]. + ^element +! ! + +!InlinedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexOf: element ifAbsent: aBlock + self keysAndValuesDo: [:key :value | value = element ifTrue: [^key]]. + ^aBlock value +! ! + +!InlinedDictionary methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +values + | values | + values := Bag new. + self do: [:element | values add: element]. + ^values +! ! + +!InlinedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationsDo: aBlock + table keysAndValuesDo: [:key :value | | assoc | + assoc := Association key: key value: value. + aBlock evaluateWith: assoc] +! ! + +!InlinedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +do: aBlock + table keysAndValuesDo: [:key :value | aBlock evaluateWith: value] +! ! + +!InlinedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keysAndElementsDo: aBlock + self keysAndValuesDo: aBlock +! ! + +!InlinedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keysAndValuesDo: aBlock + table keysAndValuesDo: aBlock +! ! + +!InlinedDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keysDo: aBlock + table keysAndValuesDo: [:key :value | aBlock evaluateWith: key] +! ! + +!InlinedDictionary methodsFor: 'adding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicAdd: anAssociation + self at: anAssociation key put: anAssociation value. + ^anAssociation +! ! + +!InlinedDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bucketClass + ^InlinedHashTable +! ! + +!InlinedDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +equates: key with: element + ^key = element +! ! + +!InlinedDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keyFor: anObject + ^anObject +! ! + +!InlinedDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +storesAssociations + ^false +! ! + +!InlinedDictionary methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keyAtValue: anObject ifAbsent: aBlock + 1 to: table size by: 2 do: [:index | + (table at: index + 1) = anObject + ifTrue: [(table at: index) ifNotNil: [:k | ^k]]]. + ^aBlock value +! ! + +!Namespace methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +_namespaceLookup: aSymbol + | table | + table := namespace _basicAt: 2. + 2 + to: table _size + do: [:j | | assoc | + assoc := (table _basicAt: j). + assoc == nil ifFalse: [ + assoc key == aSymbol + ifTrue: [^table _basicAt: j + 1]]]. + ^nil +! ! + +!Namespace class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new + ^super new +! ! + +!WeakIdentityDictionary methodsFor: 'adding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +add: anAssociation + self ASSERT: anAssociation class == Ephemeron. + ^self critical: [super add: anAssociation] +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationClass + ^Ephemeron new registry: self +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +critical: aBlock + | save | + save := critical. + critical := true. + ^[aBlock value] ensure: [critical := save] +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +equates: element with: ephemeron + ^element == ephemeron key +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hashFor: element + ^element basicHash +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keyCollector + ^IdentitySet new: self size +! ! + +!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +rescue: anEphemeron + critical + ifTrue: [anEphemeron activate] + ifFalse: [self removeKey: anEphemeron key ifAbsent: nil] +! ! + +!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationsDo: aBlock + self critical: [ + super associationsDo: [:ephemeron | | hold | + hold := ephemeron key. + hold notNil ifTrue: [aBlock value: ephemeron]]] +! ! + +!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +do: aBlock + self associationsDo: [:assoc | aBlock evaluateWith: assoc value] +! ! + +!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +ephemeronsDo: aBlock + self associationsDo: aBlock +! ! + +!WeakIdentityDictionary methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +onTable: aHashTable + critical := false. + super onTable: aHashTable +! ! + +!HashedCollection methodsFor: 'adding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +add: element + (table atKey: element put: element) == nil ifTrue: [self incrementTally]. + ^element +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: anInteger + ^self errorNotIndexable +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: anInteger put: anObject + ^self errorNotIndexable +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bucketClass + ^OpenHashTable +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keyFor: anObject + ^anObject +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +policy + ^table notNil ifTrue: [table policy] ifFalse: [self] +! ! + +!HashedCollection methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +size + ^tally +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicAdd: element + tally := tally + 1. + table basicAtKey: element put: element. + ^element +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bucketOfSize: anInteger + ^(self bucketClass new: anInteger) owner: self +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +contentOfSize: anInteger + ^self policy == self + ifTrue: [(self bucketClass new: anInteger) owner: self] + ifFalse: [self policy contentOfSize: anInteger] +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +contents + ^table +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +defaultPolicy + ^HashTablePolicy new + storesAssociations: self storesAssociations; + bucketClass: self bucketClass +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +emptySlot + ^nil +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +equates: key with: element + ^key = element +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +grow + self resizeTo: tally * 2 +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hashFor: anObject + ^anObject hash +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +incrementTally + tally := tally + 1. + (table isCapacityGreaterThan: tally) ifFalse: [self grow] +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +maxSlots + ^self policy == self ifFalse: [self policy maxSlots] +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +resizeTo: anInteger + | copy t policy n | + n := self class sizeFor: anInteger. + t := self contentOfSize: n. + copy := self class on: t. + policy := self policy. + policy == self ifFalse: [ + self ASSERT: policy class == HashTablePolicy. + copy usePolicy: policy copy]. + self rebuildOn: copy. + policy == self ifTrue: [table policy: self] ifFalse: [table policy: policy] +! ! + +!HashedCollection methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +table + ^table +! ! + +!HashedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicDo: aBlock + table elementsDo: aBlock count: tally +! ! + +!HashedCollection methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +do: aBlock + self basicDo: aBlock +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +beWeak + | policy | + policy := self policy. + policy == self ifTrue: [policy := self defaultPolicy]. + policy useWeakSlots. + table beWeak. + self usePolicy: policy +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +maxSlots: anInteger + | policy | + policy := self policy. + policy == self ifTrue: [policy := self defaultPolicy]. + policy maxSlots: anInteger. + self usePolicy: policy +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +rehash + tally isNil ifTrue: [tally := table count]. + self resizeTo: tally +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +useDefaultPolicy + table policy == self ifTrue: [^self]. + table policy: self. + self notEmpty ifTrue: [self rehash] +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +useIdentityHash + | policy | + policy := self defaultPolicy. + policy useIdentityHash. + self usePolicy: policy +! ! + +!HashedCollection methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +usePolicy: aHashTablePolicy + table isNil ifTrue: [^self]. + table policy: aHashTablePolicy. + aHashTablePolicy usesWeakSlots + ifTrue: [self class registerPolicy: aHashTablePolicy for: self]. + self notEmpty ifTrue: [self rehash] +! ! + +!HashedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +copy + | copy | + copy := super copy. + table policy == self ifTrue: [copy useDefaultPolicy] ifFalse: [ + self ASSERT: table policy class == HashTablePolicy. + copy usePolicy: table policy copy]. + ^copy +! ! + +!HashedCollection methodsFor: 'copying' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +postCopy + super postCopy. + table := table copy +! ! + +!HashedCollection methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initialize: anInteger + | t | + t := self contentOfSize: anInteger. + self onTable: t +! ! + +!HashedCollection methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initializeWeakSize: anInteger + self initialize: anInteger. + table beWeak +! ! + +!HashedCollection methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +onTable: aHashTable + tally := 0. + table := aHashTable +! ! + +!HashedCollection methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +occurrencesOf: anObject + ^(self includes: anObject) ifTrue: [1] ifFalse: [0] +! ! + +!HashedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +remove: anObject ifAbsent: aBlock + table removeKey: anObject ifAbsent: [^aBlock value]. + tally := tally - 1. + ^anObject +! ! + +!HashedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeAll + tally = 0 ifTrue: [^self]. + table removeAll. + tally := 0 +! ! + +!HashedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeAll: aCollection + ^self removeAll: aCollection ifAbsent: [self errorNotFound] +! ! + +!HashedCollection methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeAll: aCollection ifAbsent: aBlock + | n | + n := aCollection size. + table removeKeys: aCollection ifAbsent: [ + n := n - 1. + aBlock value]. + tally := tally - n. + ^aCollection +! ! + +!HashedCollection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +storesAssociations + ^false +! ! + +!HashedCollection methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +usesWeakSlots + | p | + p := self policy. + ^p !!== self and: [p usesWeakSlots] +! ! + +!HashedCollection class methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initializePolicies + Policies := WeakIdentityDictionary new +! ! + +!HashedCollection class methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +registerPolicy: aHashTablePolicy for: aHashedCollection + Policies at: aHashedCollection put: aHashTablePolicy +! ! + +!HashedCollection class methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sizeFor: anInteger + ^7 max: anInteger * 3 // 2 +! ! + +!HashedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new + ^self new: 5 +! ! + +!HashedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new: anInteger + | size | + size := self sizeFor: anInteger. + ^self basicNew initialize: size +! ! + +!HashedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new: anInteger using: aHashedCollectionPolicy + | size | + size := self sizeFor: anInteger. + ^self basicNew + onTable: (aHashedCollectionPolicy contentOfSize: size); + usePolicy: aHashedCollectionPolicy +! ! + +!HashedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +on: aHashTable + ^self new onTable: aHashTable +! ! + +!HashedCollection class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +withAll: aCollection + | instance | + instance := self new: aCollection size. + ^instance addAll: aCollection; yourself +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beFatal + resumable := retryable := false +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beResumable + resumable := true +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beWarning + resumable := true +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compiler + ^compiler +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compiler: aCompiler + compiler := aCompiler. + compiler result error: self +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +description: aString + description := aString +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isResumable + ^resumable + +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +proceed + retryable := false. + compiler result beSuccessful. + self isResumable ifTrue: [ self resume ] ifFalse: [ self return ] +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +source + ^compiler sourceCode copyFrom: stretch start to: stretch end +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +stretch + ^stretch +! ! + +!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +stretch: aStretch + stretch := aStretch +! ! + +!SCompilationError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isUndeclaredAccess + ^false +! ! + +!SCompilationError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isUndeclaredAssignment + ^ false +! ! + +!SUndeclaredIdentifierError methodsFor: 'accessing-token' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assignment: aBoolean + assigned := aBoolean +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +identifier + ^ identifier +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isUndeclaredAccess + ^assigned not +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isUndeclaredAssignment + ^assigned +! ! + +!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +stretch: aStretch + super stretch: aStretch. + identifier := self source +! ! + +!StackOverflow methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +defaultDescription + ^'Stack overflow' +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +* aNumber + | new result | + aNumber isFloat ifFalse: [^self * aNumber asFloat]. + new := Float new. + result := self _floatMultiply: aNumber into: new. + result == new ifTrue: [^result]. + ^self errorOn: #'*' status: result +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! ++ aNumber + | new result | + aNumber isFloat ifFalse: [^aNumber addTo: self]. + new := Float new. + result := self _floatPlus: aNumber into: new. + result == new ifTrue: [^result]. + ^self errorOn: #'+' status: result +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +- aNumber + | new result | + aNumber isFloat ifFalse: [^self - aNumber asFloat]. + new := Float new. + result := self _floatMinus: aNumber into: new. + result == new ifTrue: [^result]. + ^self errorOn: #'-' status: result +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +/ aNumber + | new result | + aNumber isFloat ifFalse: [^self / aNumber asFloat]. + new := Float new. + result := self _floatQuotient: aNumber into: new. + result == new ifTrue: [^result]. + ^self errorOn: #'/' status: result +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +timesTwoPower: anInteger + | result status | + result := self copy. + status := result _timesTwoPower: anInteger asFloat. + (Float hasErrorFlag: status) ifFalse: [^result]. + self errorOn: #timesTwoPower status: status +! ! + +!LMRFloat methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +truncated + | result | + result := self _floatTruncated. + (result notNil and: [result = 0 or: [result sign = self sign]]) + ifTrue: [^result]. + self isSpecialValue ifTrue: [^self]. + ^self abs < 2.0e16 + ifTrue: [| q r | + q := self quo: 536870912.0. + "((SmallInteger largestPositive bitShift: -1) + 1) asFloat" + r := self - (q asFloat * 536870912.0). + q * 536870912 + r truncated] + ifFalse: [self asTrueFraction] +! ! + +!LMRFloat methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +< aNumber + | result | + aNumber isFloat ifFalse: [^self < aNumber asFloat]. + result := self _floatLessThan: aNumber. + result _isSmallInteger ifFalse: [^result]. + ^self errorOn: #'<' status: result +! ! + +!LMRFloat methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! += aNumber + | result nan equal | + aNumber isFloat + ifFalse: [^aNumber isNumber + ifTrue: [self = aNumber asFloat] + ifFalse: [false]]. + result := self _floatEquals: aNumber. + result _isSmallInteger ifFalse: [^result]. + nan := self isNaN. + equal := nan == aNumber isNaN. + equal ifFalse: [^false]. + nan ifTrue: [^true]. + ^self errorOn: #'=' status: result +! ! + +!LMRFloat methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: index + ^self basicByteAt: index +! ! + +!LMRFloat methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicAt: index + ^self basicByteAt: index +! ! + +!LMRFloat methodsFor: 'random' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fractionPart + | new result | + new := Float new. + result := self _floatFractionPartInto: new. + result == new ifTrue: [^result]. + ^self errorOn: #fractionPart status: result +! ! + +!LMRFloat methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +significand + | result new | + new := Float new. + result := self _floatSignificandInto: new. + result == new ifTrue: [^result]. + ^self errorOn: #significand status: result +! ! + +!LMRFloat methodsFor: 'functions' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sqrt + | sqrt result | + sqrt := Float new. + result := self _floatSqrtInto: sqrt. + "_floatSqrtInto returns error status in result if any, else the result itself" + result == sqrt ifTrue: [^result]. + ^self errorOn: #sqrt status: result +! ! + +!LMRFloat class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromInteger: anInteger + | result | + result := Float new. + anInteger _isSmallInteger ifTrue: [ + anInteger _asFloatInto: result. + ^result]. + anInteger isInteger + ifTrue: [^(self fromInteger: (anInteger bitShift: -24)) * 16r1000000 asFloat + + (self fromInteger: (anInteger bitAnd: 16rFFFFFF))] + ifFalse: [self error: 'number is not an integer'] +! ! + +!LMRFloat class methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initialControlAndStatusFlags + " + FIXME: ONLY X64 SUPPORTED FOR NOW + We initialize MXCSR with all sticky bits clean (0-5), all exceptions masked (7-12), + and denormal arguments of operations treated as zero (bit 6). + We don't flush denormal results to zero (bit 15), but should think about it. + " + ^0x1FC0 +! ! + +!LMRFloat class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initializeStatus + " + this has to be done fairly early at startup, before + doing any float operation, because float operations + try to use this value, which must be already initialized + to what the OS put in MXCSR (or equivalent) register + " + Status isNil ifTrue: [Status := ByteArray new: 4]. + Status uLongAtOffset: 0 put: self status +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +* aNumber + ^aNumber class == self class + ifTrue: [aNumber multiplyScaledDecimal: self] + ifFalse: [self retry: #'*' with: aNumber] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! ++ aNumber + ^aNumber class == self class + ifTrue: [aNumber addToScaledDecimal: self] + ifFalse: [self retry: #'+' with: aNumber] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +- aNumber + ^aNumber class == self class + ifTrue: [aNumber subtractFromScaledDecimal: self] + ifFalse: [self retry: #'-' with: aNumber] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +/ aNumber + ^aNumber class == self class + ifTrue: [aNumber divideIntoScaledDecimal: self] + ifFalse: [self retry: #'/' with: aNumber] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +// aNumber + | q quo | + q := self / aNumber. + quo := q floor. + ^(q negative andNot: [q = quo]) ifTrue: [quo] ifFalse: [quo - 1] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +negated + ^self class fromNumber: self asFraction negated scale: scale +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +raisedTo: aNumber + | fraction | + fraction := super raisedTo: aNumber. + ^self class fromNumber: fraction scale: scale +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +raisedToInteger: aNumber + | fraction | + fraction := super raisedToInteger: aNumber. + ^self class fromNumber: fraction scale: scale +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +reciprocal + ^self class fromNumber: self asFraction reciprocal scale: scale +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sqrt + | sqrt | + sqrt := self asFraction sqrt. + ^sqrt isFloat + ifTrue: [sqrt] + ifFalse: [ScaledDecimal fromNumber: sqrt scale: scale] +! ! + +!ScaledDecimal methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +squared + ^super squared scale: scale +! ! + +!ScaledDecimal methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +< aNumber + aNumber = 0 ifTrue: [^numerator < 0]. + ^self - aNumber < 0 +! ! + +!ScaledDecimal methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +<= aNumber + ^self < aNumber or: [self = aNumber] +! ! + +!ScaledDecimal methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! += aNumber + self class == aNumber class ifTrue: [^self asFraction = aNumber asFraction]. + ^self asFraction = aNumber +! ! + +!ScaledDecimal methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +> aNumber + aNumber = 0 ifTrue: [^numerator > 0]. + ^self - aNumber > 0 +! ! + +!ScaledDecimal methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +>= aNumber + ^self > aNumber or: [self = aNumber] +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +addToScaledDecimal: aScaledDecimal + | s den fraction | + s := self scale max: aScaledDecimal scale. + den := aScaledDecimal denominator. + fraction := denominator = den + ifTrue: [ + self class + numerator: numerator + aScaledDecimal numerator + denominator: denominator] + ifFalse: [ + self class + numerator: numerator * den + (aScaledDecimal numerator * denominator) + denominator: denominator * den]. + ^fraction scale: s; reduced +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +coerce: aNumber + ^self class fromNumber: aNumber scale: scale +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +divideIntoScaledDecimal: aScaledDecimal + | s fraction | + s := scale max: aScaledDecimal scale. + fraction := self class + numerator: aScaledDecimal numerator * denominator + denominator: aScaledDecimal denominator * numerator. + ^fraction scale: s; reduced +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +multiplyScaledDecimal: aScaledDecimal + | s fraction | + s := scale max: aScaledDecimal scale. + fraction := self class + numerator: aScaledDecimal numerator * numerator + denominator: aScaledDecimal denominator * denominator. + ^fraction scale: s; reduced +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +reduced + | gcd | + gcd := numerator gcd: denominator. + gcd = 1 ifTrue: [^self]. + ^self class + numerator: numerator // gcd + denominator: denominator // gcd + scale: self scale +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +retry: selector with: argument + ^argument isFloat + ifTrue: [(argument coerce: self) perform: selector with: argument] + ifFalse: [self perform: selector with: (self coerce: argument)] +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +setNumerator: num denominator: den scale: s + den = 0 ifTrue: [^self zeroDivisorOn: #setNumerator:denominator:scale:]. + denominator := den truncated abs. + den negative ifTrue: [numerator := numerator negated]. + numerator := num truncated. + scale := s truncated +! ! + +!ScaledDecimal methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +subtractFromScaledDecimal: aScaledDecimal + | s den fraction | + s := scale max: aScaledDecimal scale. + den := aScaledDecimal denominator. + fraction := denominator = den + ifTrue: [ + self class + numerator: aScaledDecimal numerator - numerator + denominator: denominator] + ifFalse: [ + self class + numerator: aScaledDecimal numerator * denominator - (numerator * den) + denominator: denominator * den]. + ^fraction scale: s; reduced +! ! + +!ScaledDecimal methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asFloat + ^numerator asFloat / denominator +! ! + +!ScaledDecimal methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asFraction + ^Fraction numerator: numerator denominator: denominator +! ! + +!ScaledDecimal methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isFraction + ^false +! ! + +!ScaledDecimal methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +printOn: aStream + | scaler scaled quo rem | + scaler := 10 raisedToInteger: scale. + scaled := numerator * scaler + (denominator bitShift: -1) // denominator. + numerator < 0 ifTrue: [ + aStream nextPut: $-. + scaled := scaled negated]. + quo := scaled // scaler. + rem := scaled \\ scaler. + quo printOn: aStream. + scale > 0 ifTrue: [aStream nextPut: $.]. + scale timesRepeat: [ + rem := rem * 10. + aStream nextPut: (Character digitValue: rem // scaler). + rem := rem \\ scaler]. + aStream nextPut: $s; nextPutAll: scale asString +! ! + +!ScaledDecimal methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +storeOn: aStream + (denominator = 1 or: [(10 raisedTo: scale) \\ denominator = 0]) + ifTrue: [^self printOn: aStream]. + numerator storeOn: aStream. + aStream nextPut: $/. + denominator storeOn: aStream. + aStream nextPut: $s; nextPutAll: scale asString +! ! + +!ScaledDecimal methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +scale + ^scale +! ! + +!ScaledDecimal methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +scale: anInteger + scale := anInteger +! ! + +!ScaledDecimal class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromNumber: aNumber scale: anInteger + | fraction | + fraction := aNumber asFraction. + ^self + numerator: fraction numerator + denominator: fraction denominator + scale: anInteger +! ! + +!ScaledDecimal class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fromString: aString + | value i n num den | + value := super fromString: aString. + value class == self ifTrue: [^value]. + i := aString indexOf: $.. + i = 0 ifTrue: [^self fromNumber: value scale: 0]. + n := aString size - i. + num := (aString copyWithout: $.) asInteger. + den := 10 raisedToInteger: n. + ^self fromNumber: num / den scale: n +! ! + +!ScaledDecimal class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +numerator: numerator denominator: denominator scale: scale + " + ScaledDecimal numerator: 1 denominator: 3 scale: 2 + " + ^(self numerator: numerator denominator: denominator) scale: scale +! ! + +!ArgParser methodsFor: 'commands' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +addCommand: aCommand + commands at: aCommand name put: aCommand +! ! + +!ArgParser methodsFor: 'options' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +addGlobalOption: anOption + globalOptions add: anOption +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +description + ^description +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +description: aString + description := aString +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +name + ^name +! ! + +!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +name: aString + name := aString +! ! + +!ArgParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +extractGlobalArgs: args + | remaining i | + remaining := OrderedCollection new. + i := 1. + [i <= args size] whileTrue: [ + | arg match rest | + arg := args at: i. + match := globalOptions detect: [:opt | opt matches: arg] ifNone: [nil]. + match ifNotNil: [ + match hasValue ifTrue: [i := i + 1] + ] ifNil: [ + rest := args copyFrom: i to: args size. + ^remaining addAll: rest; yourself]. + i := i + 1]. + ^remaining +! ! + +!ArgParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +parse: args + | remaining key command result tail | + remaining := self extractGlobalArgs: args. + remaining isEmpty ifTrue: [self printHelp. ^nil]. + key := remaining first. + command := commands at: key ifAbsent: [ + self error: 'Unknown command: ', key, '. Run with no args for help.']. + result := ParseResult new. + result command: key. + tail := remaining copyFrom: 2 to: remaining size. + command parse: tail into: result. + command action ifNotNil: [:act | act value: result]. + ^result +! ! + +!ArgParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +initialize + commands := OrderedDictionary new. + globalOptions := OrderedCollection new +! ! + +!ArgParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +printHelp + | text | + text := name ifNil: ['command']. + description ifNotNil: [ + text := text , ' - ' , description]. + text := text , String cr , String cr , 'Commands:' , String cr. + commands keysAndValuesDo: [:key :cmd | + text := text , ' ' , key. + cmd description ifNotNil: [:d | + text := text , ' - ' , d]. + text := text , String cr]. + Kernel log: text +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +action + ^action +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +action: aBlock + action := aBlock +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +description + ^description +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +description: aString + description := aString +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +name + ^name +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +name: aString + name := aString +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +options + ^options +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +positionalNames + ^positionalNames +! ! + +!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +subcommands + ^subcommands +! ! + +!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +addOption: anOption + options add: anOption +! ! + +!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +addPositional: aString + positionalNames add: aString +! ! + +!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +addSubcommand: aCommand + subcommands at: aCommand name put: aCommand +! ! + +!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +applyDefaults: aResult + options do: [:opt | + (aResult hasOption: opt name) ifFalse: [ + opt defaultValue ifNotNil: [:v | + aResult setOption: opt name to: v]]] +! ! + +!Command methodsFor: 'private' stamp: 'KenD 1/Jul/2026, 7:35:08 pm (UTC)'! +checkRequired: aResult + options do: [:opt | + | aName | + aName := opt long ifNil: [opt short]. + (opt required and: [(aResult hasOption: opt name) not]) + ifTrue: [self error: 'Required option missing: ', aName]] +! ! + +!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +findOption: aString + ^options detect: [:opt | opt matches: aString] ifNone: [nil] +! ! + +!Command methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +hasSubcommands + ^subcommands notEmpty +! ! + +!Command methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +initialize + options := OrderedCollection new. + positionalNames := OrderedCollection new. + subcommands := OrderedDictionary new +! ! + +!Command methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +parse: args into: result + | i | + i := 1. + [i <= args size] whileTrue: [ + | arg | + arg := args at: i. + (arg first = $-) + ifTrue: [i := self parseOption: arg from: args at: i into: result] + ifFalse: [result addPositional: arg]. + i := i + 1]. + self checkRequired: result. + self applyDefaults: result +! ! + +!Command methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +parseOption: aString from: anArray at: anInteger into: aResult + | opt | + opt := self findOption: aString. + opt ifNil: [self error: 'Unknown option: ', aString]. + opt hasValue ifTrue: [ + | val next | + next := anInteger + 1. + next > anArray size ifTrue: [self error: 'Option ', aString, ' requires a value']. + val := anArray at: next. + aResult setOption: opt name to: val. + ^next] + ifFalse: [ + aResult setOption: opt name to: true]. + ^anInteger +! ! + +!Command methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +printUsageOn: aStream + aStream nextPutAll: name. + positionalNames do: [:pname | + aStream nextPutAll: ' <'; nextPutAll: pname; nextPut: $>]. + options do: [:opt | + aStream nextPutAll: ' ['. + opt short ifNotNil: [:s | aStream nextPutAll: s]. + (opt short notNil and: [opt long notNil]) ifTrue: [aStream nextPutAll: '|']. + opt long ifNotNil: [:l | aStream nextPutAll: l]. + opt hasValue ifTrue: [aStream nextPutAll: ' ']. + aStream nextPut: $]] +! ! + +!Option methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +beFlag + hasValue := false. + defaultValue := false +! ! + +!Option methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +beRequired + required := true +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +defaultValue + ^defaultValue +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +defaultValue: anObject + defaultValue := anObject +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +description + ^description +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +description: aString + description := aString +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +long + ^long +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +long: aString + long := aString +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +name + long ifNotNil: [^long copyFrom: 3]. + ^short copyFrom: 2 +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +short + ^short +! ! + +!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +short: aString + short := aString +! ! + +!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +hasValue + ^hasValue +! ! + +!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +matches: aString + ^aString = short or: [aString = long] +! ! + +!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +required + ^required +! ! + +!Option methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +initialize + required := false. + hasValue := true. + defaultValue := nil +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +addPositional: aString + positionals add: aString +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +command + ^command +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +command: aString + command := aString +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +optionAt: aString + ^options at: aString ifAbsent: [nil] +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +optionAt: aString ifAbsent: aBlock + ^options at: aString ifAbsent: aBlock +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +options + ^options +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +positionalAt: anInteger + ^positionals at: anInteger +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +positionals + ^positionals +! ! + +!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +setOption: aString to: aValue + options at: aString put: aValue +! ! + +!ParseResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +hasOption: aString + ^options includesKey: aString +! ! + +!ParseResult methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +initialize + positionals := OrderedCollection new. + options := OrderedDictionary new +! ! + +!MethodSpec methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! += aMethodSpec + ^aMethodSpec class = self class + and: [aMethodSpec selector == selector] + and: [aMethodSpec classBinding = class] +! ! + +!MethodSpec methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +hash + ^class name hash hashWith: selector +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +asCompiledMethod + self canBeCompiled ifFalse: [^nil]. + ^self + propertyAt: #compiledMethod + ifAbsentPut: [self compiler compileMethod: source] +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +ast + self canBeCompiled ifFalse: [^nil]. + ^ast ifNil: [ast := self compiler parseMethod: source] +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cannonicalAst + ^self halt propertyAt: #cannonicalAst ifAbsentPut: [self ast] +! ! + +!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +referencedIdentifiers + ^self ast ifNil: [#()] ifNotNil: [:node | node identifiers] +! ! + +!MethodSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +bytecodes + ^self canBeCompiled ifTrue: [self asCompiledMethod bytecodes] +! ! + +!MethodSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +classname + ^class name +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +canBeCompiled + ^self compiler notNil +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +canBeParsed + ^self cannonicalAst notNil +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +equals: aMethodSpec + ^self canBeCompiled + and: [aMethodSpec canBeCompiled] + and: [self isFrameless not] + and: [self isEquivalentTo: aMethodSpec] +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isEquivalentTo: aMethodSpec + | m1 m2 | + selector == aMethodSpec selector ifFalse: [^false]. + class == aMethodSpec classBinding ifFalse: [^false]. + m1 := self asCompiledMethod. + m1 isNil ifTrue: [^false]. + m2 := aMethodSpec asCompiledMethod. + m2 isNil ifTrue: [^false]. + ^m1 equals: m2 +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isExtension + ^class isExtension +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isFrameless + ^self halt asCompiledMethod isFrameless +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +referencesIdentifier: aString + ^self referencedIdentifiers + anySatisfy: [:identifier | identifier name = aString] +! ! + +!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +usesInstanceVariableNamed: aString + ^(self ast variableNamed: aString) notNil +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +category + ^self isExtension + ifTrue: ['*' , (module name readStream upToLast: $-)] + ifFalse: [category] +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +category: aString + category := aString +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +classBinding + ^class +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +classBinding: aSpeciesSpec + class := aSpeciesSpec +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +module + ^module +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +module: aModuleSpec + module := aModuleSpec +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeFromClass + class removeMethod: self +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +selector + ^selector +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +selector: aSymbol + selector := aSymbol +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +source + ^source +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +source: aString + source := aString. + ast := nil +! ! + +!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +sourceCode + ^source +! ! + +!MethodSpec methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream nextPutAll: class name asString , '>>#' , selector asString +! ! + +!MethodSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +resolveClass + ^module resolveClass: class name +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addClass: aClassSpec + classes add: aClassSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addClassExtension: aClassSpec + extendedClasses add: aClassSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addClasses: aCollection + aCollection do: [:c | self addClass: c] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addDependencies: aCollection + aCollection keysAndValuesDo: [:dep :objects | + dependencies + at: dep + put: objects + ifPresent: [:current | (current addAll: objects) withoutDuplicates]] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addSubclassifiedClass: aClassSpec + subclassifiedClasses addIfAbsent: aClassSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +associationAt: aSymbol ifAbsent: aBlock + ^imports associationAt: aSymbol ifAbsent: aBlock +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cleanDependencies + | needed | + needed := OrderedCollection new. + self methodReferences keys do: [:identifier | needed add: identifier name]. + self hierarchyReferences keys + do: [:identifier | needed add: identifier name]. + extendedClasses do: [:c | needed add: c name]. + dependencies copy keysAndValuesDo: [:module :identifiers | + (identifiers keys anySatisfy: [:identifier | needed includes: identifier]) + ifFalse: [dependencies removeKey: module]] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +hierarchyReferences + | references | + references := Dictionary new. + self allClassesDo: [:c | | list | + c superclass ifNotNil: [ + list := references at: c superclass ifAbsentPut: [OrderedCollection new]. + list add: c]]. + ^references +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +methodReferences + | references | + references := Dictionary new. + self allMethodsDo: [:m | + m referencedIdentifiers reject: #isLocal thenDo: [:identifier | | list | + list := references at: identifier ifAbsentPut: [OrderedCollection new]. + list add: m]]. + ^references +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream + nextPut: $<; + print: name; + nextPutAll: '> module' +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeCategory: aSymbol inClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + class removeCategory: aSymbol +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + classes remove: class ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeEmptyExtensions + extendedClasses copy + reject: #hasMethods + thenDo: [:c | extendedClasses remove: c] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeExtendedClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + extendedClasses remove: class ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeMethod: aMethodSpec + self ASSERT: (self includesClass: aMethodSpec classBinding). + aMethodSpec classBinding removeMethod: aMethodSpec +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeSelectors: aCollection + self allClassesDo: [:c | + c removeSelectors: aCollection. + c metaclass removeSelectors: aCollection] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeSelectors: aCollection inClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + class removeSelectors: aCollection +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeSelectors: aCollection inScope: aClassSpec + | class all | + class := self resolveClass: aClassSpec. + all := self withAllSubclasses: class. + all do: [:c | c removeSelectors: aCollection] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeSubclassesOf: aClassSpec + | class | + class := self resolveClass: aClassSpec. + class allSubclasses do: [:c | self removeClass: c; removeExtendedClass: c] +! ! + +!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeSubclassifiedClass: aClassSpec + | class | + class := self resolveClass: aClassSpec. + subclassifiedClasses remove: class ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addImport: anAssociation + imports add: anAssociation +! ! + +!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addImports: aCollection + aCollection do: [:token | self addImport: token asSymbol -> nil] +! ! + +!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + classes := OrderedCollection new. + extendedClasses := OrderedCollection new. + subclassifiedClasses := OrderedCollection new. + imports := Dictionary new. + dependencies := Dictionary new +! ! + +!ModuleSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allClasses + ^classes , extendedClasses +! ! + +!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allClassesDo: aBlock + classes do: aBlock. + extendedClasses do: aBlock +! ! + +!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allMethods + | methods | + methods := OrderedCollection new. + self allMethodsDo: [:m | methods add: m]. + ^methods +! ! + +!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allMethodsDo: aBlock + self allClassesDo: [:c | + c metaclass methods do: aBlock. + c methods do: aBlock] +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +at: aSymbol + ^self at: aSymbol ifAbsent: nil +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +at: aSymbol ifAbsent: aBlock + | string | + string := aSymbol asString. + classes do: [:c | c name = string ifTrue: [^c]]. + extendedClasses do: [:c | c name = string ifTrue: [^c]]. + subclassifiedClasses do: [:c | c name = string ifTrue: [^c]]. + ^imports at: aSymbol ifAbsent: aBlock +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +classes + ^classes +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +dependencies + ^dependencies +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +dependencies: aDictionary + dependencies := aDictionary +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +description + ^description +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +description: aString + description := aString +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +extendedClasses + ^extendedClasses +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name + ^name +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name: aString + name := aString +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +referencedGlobals + | referenced | + referenced := Dictionary new. + self allMethodsDo: [:m | + m referencedIdentifiers + select: [:identifier | | b | + b := identifier binding. + b refersToGlobal or: [b isUnresolved]] + thenDo: [:global | (referenced + at: global name + ifAbsentPut: [OrderedCollection new]) + add: m]]. + ^referenced +! ! + +!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +requiredImports + | required | + required := Dictionary new. + self referencedGlobals + keysAndValuesDo: [:global :dependents | (self definesGlobal: global) + ifFalse: [required at: global put: dependents]]. + ^required +! ! + +!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +basicResolveClass: aString + classes do: [:c | c name asString = aString ifTrue: [^c]]. + extendedClasses do: [:c | c name asString = aString ifTrue: [^c]]. + subclassifiedClasses do: [:c | c name asString = aString ifTrue: [^c]]. + ^nil +! ! + +!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +definesGlobal: aString + ^classes anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +resolveClass: class + | moniker metaclass found | + moniker := class isString ifTrue: [class] ifFalse: [class name]. + metaclass := moniker endsWith: ' class'. + metaclass ifTrue: [moniker := moniker trimTail: ' class']. + found := self basicResolveClass: moniker. + ^found ifNotNil: [metaclass ifTrue: [found metaclass] ifFalse: [found]] +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +definesClassNamed: aString + ^classes anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +extendsClassNamed: aString + ^extendedClasses anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +includesClass: aClassSpec + ^(self resolveClass: aClassSpec) notNil +! ! + +!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +subclassifiesClassNamed: aString + ^subclassifiedClasses anySatisfy: [:c | c name = aString] +! ! + +!ModuleSpec methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +sortedClasses + | remaining sorted | + remaining := classes copy. + sorted := OrderedCollection new. + [remaining isEmpty] whileFalse: [| c | + c := remaining first. + (remaining includes: c superclass) + ifTrue: [remaining removeFirst; add: c] + ifFalse: [ + remaining remove: c. + sorted add: c]]. + ^sorted +! ! + +!ModuleSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +withAllSubclasses: aClassSpec + | all | + all := self allClasses. + aClassSpec isMetaclass ifTrue: [all := all collect: #metaclass]. + ^all select: [:c | c withAllSuperclasses includes: aClassSpec] +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addMethod: aMethodSpec + ^methods add: aMethodSpec +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addMethods: aCollection + aCollection do: [:m | self addMethod: m] +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeCategory: aSymbol + methods removeAllSuchThat: [:m | m category == aSymbol] +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeMethod: aMethodSpec + methods remove: aMethodSpec ifAbsent: nil +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeSelector: aSymbol + methods removeAllSuchThat: [:m | m selector == aSymbol] +! ! + +!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +removeSelectors: aCollection + methods removeAllSuchThat: [:m | aCollection includes: m selector] +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allInstVarNames + ^(self withAllSuperclasses reversed gather: [:c | c instVarNames]) asArray +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allSharedPools + | pools | + pools := Set new. + self withAllSuperclasses do: [:c | pools addAll: c sharedPools]. + ^pools +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allSuperclasses + | superclasses | + superclasses := OrderedCollection new. + self allSuperclassesDo: [:s | superclasses add: s]. + ^superclasses +! ! + +!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +withAllSuperclasses + ^OrderedCollection with: self withAll: self allSuperclasses +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allSubclasses + | all | + all := OrderedCollection new. + self allSubclassesDo: [:cls | all add: cls]. + ^all +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allSubclassesDo: aBlock + self subclasses do: [:class | + aBlock value: class. + class allSubclassesDo: aBlock] +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +beArrayed + format := format | IsArrayed +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +beBytes + format := format | IsBytes +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +instVarNames + ^instanceVariables +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +instVarNames: aCollection + instanceVariables := aCollection asOrderedCollection +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +ivars: aCollection + instanceVariables := aCollection asOrderedCollection +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +methods + ^methods +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +module: aModuleSpec + module := aModuleSpec +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +selectors + ^methods collect: #selector +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +subclasses + ^module allClasses select: [:c | c supername = self name] +! ! + +!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +withAllSubclasses + ^OrderedCollection with: self withAll: self allSubclasses +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +hasMethods + ^methods notEmpty +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +instancesAreArrayed + ^format anyMask: IsArrayed +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +instancesHavePointers + ^(format anyMask: IsBytes) not +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isExtension + ^module extendedClasses includes: self instanceClass +! ! + +!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isMetaclass + ^false +! ! + +!SpeciesSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + super initialize. + methods := OrderedCollection new. + instanceVariables := #(). + format := 0 +! ! + +!SpeciesSpec methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream nextPutAll: '<' , self name , '>' +! ! + +!SpeciesSpec class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initializeFormatMasks + self addNamespaceAs: #Format. + Format + at: 'IsArrayed' put: 0x1; + at: 'IsBytes' put: 0x2 +! ! + +!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allMethods + ^methods & metaclass methods +! ! + +!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +classVarNames + ^classVariables keys +! ! + +!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +metaMethods + ^metaclass methods +! ! + +!ClassSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allSuperclassesDo: aBlock + | s | + supername isNil ifTrue: [^self]. + s := self superclass. + s isNil ifTrue: [^self]. + aBlock value: s. + s allSuperclassesDo: aBlock +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +classVariables + ^classVariables +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +configureCompiler: aCompiler + +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cvarNames: aCollection + aCollection do: [:cvar | classVariables at: cvar put: nil] +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cvars: aCollection + classVariables := aCollection +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +instanceClass + ^self +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isPointers + ^pointers +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isPointers: aBoolean + pointers := aBoolean +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isVariable + ^variable +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isVariable: aBoolean + variable := aBoolean +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +metaclass + ^metaclass +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +metaclass: aMetaclassSpec + metaclass := aMetaclassSpec +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name + ^name +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name: aString + name := aString +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +sharedPools + ^sharedPools +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +sharedPools: aCollection + sharedPools addAll: aCollection +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +superclass + supername ifNil: [^nil]. + ^module resolveClass: supername +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +supername + ^supername +! ! + +!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +supername: aString + supername := aString +! ! + +!ClassSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +hasMethods + ^super hasMethods or: [metaclass hasMethods] +! ! + +!ClassSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + super initialize. + classVariables := OrderedDictionary new. + sharedPools := OrderedCollection new +! ! + +!MetaclassSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +allSuperclassesDo: aBlock + | s c | + class supername isNil ifTrue: [ + c := module resolveClass: 'Class'. + c ifNil: [c := Class]. + c allSuperclassesDo: aBlock]. + s := self superclass. + s isNil ifTrue: [^self]. + aBlock value: s. + s allSuperclassesDo: aBlock +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +classVarNames + ^class classVarNames +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +metaMethods + ^#() +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name + ^class name , ' class' +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +sharedPools + ^class sharedPools +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +superclass + ^class superclass ifNotNil: [:c | c metaclass] +! ! + +!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +supername + ^self superclass name +! ! + +!MetaclassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +instanceClass + ^class +! ! + +!MetaclassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +instanceClass: aClassSpec + class := aClassSpec +! ! + +!MetaclassSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isMetaclass + ^true +! ! + +!Assembler methodsFor: 'labels' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +@ label + self addLabel: label +! ! + +!Assembler methodsFor: 'labels' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addLabel: aString + self addLabel: aString to: self currentAddress +! ! + +!Assembler methodsFor: 'labels' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addLabel: label to: location + labels at: label put: location +! ! + +!Assembler methodsFor: 'labels' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +newLabel + | label next | + next := labels size + 1. + IndexedLabels size < next ifTrue: [self class growIndexedLabelsTo: next]. + label := IndexedLabels at: next. + self addLabel: label to: nil. + ^label +! ! + +!Assembler methodsFor: 'labels' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +resolveLabel: aString + ^labels at: aString +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +add: source1 to: source2andDest + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addImm: imm to: dest + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +alignTo: anInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +breakpoint + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +callIndirectA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +callIndirectM + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +callR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearIntegerBit: srcAndDstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearRintegerBit + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearSafeIntegerBit: srcAndDstReg + self and: srcAndDstReg withImm: -2 +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearSafeRintegerBit + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compare: reg1 with: reg2 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compare: register withLiteral: anObject + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareAwithFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareAwithTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareSwithTindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareTwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareTwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareWithFalse: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareWithNil: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareWithTrue: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popSPindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sub: src2 from: src1AndDst + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subImm: imm from: srcAndDst + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addAtoR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addDoubleX1toX0 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addRwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addTtoR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +andRwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertAtoNativeInteger + self subclassResponsibility + +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertRtoNativeInteger + self subclassResponsibility + +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertRtoSmallInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertToNativeInteger: srcAndDstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertToSmallInteger: srcAndDstReg + self shiftLeft: srcAndDstReg byImm: 1; inc: srcAndDstReg +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertTtoNativeInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +exchangeRindirectWithT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithKnown: anObject + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativeCode + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushSmallInteger: integer + | smi | + smi := self smallInteger: integer. + self pushImm: smi +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +setIntegerBit: srcAndDstReg + self setSafeIntegerBit: srcAndDstReg +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +setRintegerBit + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +setSafeIntegerBit: srcAndDstReg + self or: srcAndDstReg withImm: 1 +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +setSafeRintegerBit + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftLeftRwithT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftLogicalRright: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRightRwithT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRleft: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRright: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftTright: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subAfromR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subAfromT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subFromRconstant: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addLiteral: anObject + | index | + index := literals + identityIndexOf: anObject + ifAbsent: [ literals + add: anObject; + size ]. + ^ index + 2 +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load:dstReg withImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load: register withLiteral: anObject + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithAindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithEindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithGlobal: aSymbol + | index | + index := NativizationEnvironment indexOfGlobal: aSymbol. + self loadAwithGindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadAwithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithRoffsetAtA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithSindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadEwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadEwithNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadEwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadFPwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadFPwithSP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadFalseWithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadFalseWithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadFalseWithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadGwithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadGwithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadGwithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithGlobal: aSymbol + | index | + index := NativizationEnvironment indexOfGlobal: aSymbol. + self loadMwithGindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithTindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadNilWithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadNilWithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadNilWithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithE + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithEindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadRwithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithM + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithRatOffsetA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithSPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithSindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSPwithFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSwithNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTrueWithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadTrueWithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTrueWithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithAindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithEindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadTwithMindex: index +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithTindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadWithFalse: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadWithNil: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadWithTrue: register + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +reserveStackSlots: amount + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +saveCallerFrame + self pushFP; loadFPwithSP +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +testIntegerBit: aRegister + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +testIntegerBitOf: aRegister + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +testRintegerBit + self subclassResponsibility +! ! + +!Assembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +testRwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addSPwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addTwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +andRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +orRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +xorAwithR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +xorFPwithFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +xorRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +and: source1andDest with: source2 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +and: source1andDest withImm: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +or: src1AndDst with: src2 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +or: source1andDest withImm: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftLeft: srcAndDst by: countReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftLeft: srcAndDst byImm: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRight: srcAndDst by: countReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRight: srcAndDst byImm: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRightArithmetic: srcAndDst by: countReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRightArithmetic: srcAndDst byImm: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +xor: src1AndDst with: src2 + ^ self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildFrame + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +bytes + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +decRindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +discardArguments: anInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithGindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithGindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSwithGindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pop: dstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +push: srcReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushImm: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushIndirectR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearFPUFlags + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareEqualDoubleX0withAindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareLessThanDoubleX0withAindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +dropTopOfFPU + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +leadingRzeroCount + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadLongMwithIPoffset: anInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMXCSRfromA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByte: dstReg from: srcBaseReg atIndexAt: srcIndexReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByte: dstReg from: srcBaseReg atIndexImm: indexImm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendShortRwithRoffset: offset + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +lock + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +moveTslots + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +readFPUStatusOnA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +scaleFloatOnRWithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeMXCSRintoA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subTslotsToSP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +writeTslots + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearRhigh32 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +dec: srcAndDstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +dropTos: count + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inc: srcAndDstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadEwithAddressOfRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadLargeX0withRindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadLargeX1withAindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadLongRwithRatOffsetA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadLongSwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRconvertingDoublePointedByR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithArgPointer + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSwithAddressOfSatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadX0withRasDouble + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popE + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popG + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popM + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushE + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushG + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushM + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compare: register withBoolean: aBoolean + aBoolean + ifTrue: [ self compareWithTrue: register ] + ifFalse: [ self compareWithFalse: register ] +! ! + +!Assembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareAwithBoolean: aBoolean + aBoolean + ifTrue: [ self compareAwithTrue ] + ifFalse: [ self compareAwithFalse ] +! ! + +!Assembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithBoolean: aBoolean + aBoolean + ifTrue: [ self compareRwithTrue ] + ifFalse: [ self compareRwithFalse ] +! ! + +!Assembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithSmallInteger: anInteger + | smi | + smi := self smallInteger: anInteger. + self compareRwithImmediate: smi +! ! + +!Assembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +smallInteger: anInteger + ^(anInteger bitShift: 1) + 1 +! ! + +!Assembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +currentAddress + self subclassResponsibility +! ! + +!Assembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +move: srcReg to: dstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +moveImm: imm to: dstReg + self subclassResponsibility +! ! + +!Assembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +wordSize + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +divideDoubleX0byX1 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithTIBatR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithThreadVariableAtR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +moveX0toR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +multiplyDoubleX0byX1 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushAatToffset: offset + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +renameByteRegisterIfNeeded: register preserving: preserved1 preserving: preserved2 during: aBlock + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +roundDoubleX0intoX1 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sqrtDoubleX0 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeAinThreadVariableAtIndexR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeDoubleResultInRindirect + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeTIBatRwithA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subDoubleX1fromX0 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +extendRtoAandDividebyT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +multiplyRbyAwideningToA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeAinTindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeByteAinRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeByteTinRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeEinRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeLargeX0inA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeLargeX0inT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeLongTinRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeLongTinRatOffsetA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeRinAindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeRinEindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeRinFPindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeRinSindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeRinTindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeShortAinRoffset: offset + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeShortTinRatOffsetA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeSinRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeTinRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeTinRatOffsetA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeTinRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfEqualTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfGreaterOrEqualSignedTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfGreaterSignedTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfLessOrEqualSignedTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfLessSignedTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfNotEqualTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfNotZeroTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfOverflowTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfSignTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfZeroTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByte: reg1 from: reg2 atOffset: offset + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loop: aBlock times: anInteger + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loopTtimes: aBlock + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +renameByteRegisterIfNeeded: register preserving: preserved during: aBlock + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +return + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfCarryTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfEqualTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfNotCarryTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfNotEqualTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfNotZeroTo: label + self shortJumpIfNotEqualTo: label +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfSignTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfZeroTo: label + self shortJumpIfEqualTo: label +! ! + +!Assembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpOver: aBlock + | label | + label := self newLabel. + self jumpTo: label. + aBlock value. + self @ label +! ! + +!Assembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpTo: label + self subclassResponsibility +! ! + +!Assembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpToMindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerBitTestOf: aRegister + | label | + self testIntegerBitOf: aRegister. + label := self newLabel. + self shortJumpIfZeroTo: label. + ^label +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerBitTestOfR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerBitTestOfT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerNativizationOf: aRegister + | label | + self convertToNativeInteger: aRegister. + label := self newLabel. + self shortJumpIfNotCarryTo: label. + ^label +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerNativizationOfA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerNativizationOfR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerNativizationOfT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledNonIntegerBitTestOf: aRegister + | label | + self testIntegerBitOf: aRegister. + label := self newLabel. + self shortJumpIfNotZeroTo: label. + ^label +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledNonIntegerBitTestOfR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithSmallInteger: anInteger + | smi | + smi := (anInteger bitShift: 1) + 1. + self loadAwithImmediate: smi +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithSmallInteger: anInteger + | smi | + smi := self smallInteger: anInteger. + self loadRwithImmediate: smi +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithImmediate: imm + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByteRwithRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByteRwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByteRwithSPatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByteTwithAindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendLongRwithRatA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendLongRwithRindex: index + self subclassResponsibility +! ! + +!Assembler methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load: dstReg fromMem: srcMemRef + self subclassResponsibility +! ! + +!Assembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +platform: aNativizationPlatform + self reset +! ! + +!Assembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +reset + labels := Dictionary new: 100. + literals := OrderedCollection new. +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regA + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regA8 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regE + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regFP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regFalse + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regG + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regIP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regM + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regNil + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regR + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regR8 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regS + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regSP + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regT + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regT8 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regTrue + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regV + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regX0 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regX1 + self subclassResponsibility +! ! + +!Assembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +restoreCallerEnvironment + self loadEwithFPindex: -2 +! ! + +!Assembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +restoreCallerFrame + self subclassResponsibility +! ! + +!Assembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +restoreCallerM + self loadMwithFPindex: -1 +! ! + +!Assembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +restoreCallerSelf + self loadSwithFPindex: 0 +! ! + +!Assembler class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +growIndexedLabelsTo: anInteger + | new | + new := (IndexedLabels size + 1 to: anInteger) + collect: [:i | ('@' , i asString) asSymbol]. + IndexedLabels := IndexedLabels , new +! ! + +!Assembler class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + self initializeIndexedLabels + +! ! + +!Assembler class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeIndexedLabels + IndexedLabels := #(). + self growIndexedLabelsTo: 100 +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +add: source1 to: source2andDest + codegen add: source1 to: source2andDest +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addImm: imm to: dest + codegen addImm: imm to: dest +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +alignTo: anInteger + codegen alignTo: anInteger +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +breakpoint + codegen breakpoint +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +callIndirectA + | memref | + memref := codegen memRef: codegen regA indexImm: 1. + codegen callIndirect: memref +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +callIndirectM + | memref | + memref := codegen memRef: codegen regM indexImm: 1. + codegen callIndirect: memref +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +callR + codegen call: codegen regR +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearRintegerBit + self dec: codegen regR +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearSafeRintegerBit + self clearSafeIntegerBit: codegen regR +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compare: reg1 with: reg2 + codegen compare: reg1 with: reg2 +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compare: register withLiteral: anObject + | index memref | + index := self addLiteral: anObject. + memref := codegen memRef: codegen regM indexImm: index. + codegen compare: register withMem: memref +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareAwithFalse + codegen compare: codegen regA with: codegen regFalse +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareAwithTrue + codegen compare: codegen regA with: codegen regTrue +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithA + codegen compare: codegen regR with: codegen regA +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithFalse + codegen compare: codegen regR with: codegen regFalse +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithImmediate: imm + codegen compare: codegen regR withImm: imm +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithNil + codegen compare: codegen regR with: codegen regNil +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareRwithTrue + codegen compare: codegen regR with: codegen regTrue +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareSwithTindex: index + | memref | + memref := codegen memRef: codegen regT indexImm: index. + codegen compare: codegen regS withMem: memref +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareTwithA + codegen compare: codegen regT with: codegen regA +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareTwithImmediate: imm + codegen compare: codegen regT withImm: imm +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareWithFalse: register + codegen compare: register with: codegen regFalse +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareWithNil: register + codegen compare: register with: codegen regNil +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareWithTrue: register + codegen compare: register with: codegen regTrue +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popSPindirect + | memref | + memref := codegen memRef: codegen regSP indexImm: 1. + codegen popIntoMem: memref +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sub: src2 from: src1AndDst + codegen sub: src2 from: src1AndDst +! ! + +!GenericAssembler methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subImm: imm from: srcAndDst + codegen subImm: imm from: srcAndDst +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addAtoR + codegen add: codegen regA to: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addDoubleX1toX0 + codegen addDouble: codegen regX1 to: codegen regX0 + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addRwithImmediate: imm + codegen addImm: imm to: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addTtoR + codegen add: codegen regT to: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +andRwithImmediate: imm + codegen and: codegen regR withImm: imm +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertAtoNativeInteger + self convertToNativeInteger: codegen regA + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertRtoNativeInteger + self convertToNativeInteger: codegen regR + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertRtoSmallInteger + self convertToSmallInteger: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertToNativeInteger: srcAndDstReg + codegen shiftRightArithmetic: srcAndDstReg byImm: 1 +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convertTtoNativeInteger + self convertToNativeInteger: codegen regT +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +exchangeRindirectWithT + | memref | + memref := codegen memRef: codegen regR indexImm: 1. + codegen exchange: codegen regT withMem: memref +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithKnown: anObject + codegen breakpoint +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativeCode + ^(NativeCode withAll: literals) code: codegen memory bytes +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +setRintegerBit + self setIntegerBit: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +setSafeRintegerBit + self setSafeIntegerBit: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftLeftRwithT + codegen shiftLeft: codegen regR by: codegen regT +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftLogicalRright: count + codegen shiftRight: codegen regR byImm: count +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRightRwithT + codegen shiftRightArithmetic: codegen regR by: codegen regT + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRleft: count + codegen shiftLeft: codegen regR byImm: count + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRright: count + codegen shiftRightArithmetic: codegen regR byImm: count + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftTright: count + codegen shiftRightArithmetic: codegen regT byImm: count + +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subAfromR + codegen sub: codegen regA from: codegen regR +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subAfromT + codegen sub: codegen regA from: codegen regT +! ! + +!GenericAssembler methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subFromRconstant: imm + codegen subImm: imm from: codegen regR +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addSPwithImmediate: imm + codegen addImm: imm to: codegen regSP +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addTwithImmediate: imm + codegen addImm: imm to: codegen regT +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +andRwithA + codegen and: codegen regR with: codegen regA +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +orRwithA + codegen or: codegen regR with: codegen regA + +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +xorAwithR + codegen xor: codegen regA with: codegen regR +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +xorFPwithFP + codegen xor: codegen regFP with: codegen regFP +! ! + +!GenericAssembler methodsFor: 'logic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +xorRwithA + codegen xor: codegen regR with: codegen regA +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +and: source1andDest with: source2 + codegen and: source1andDest with: source2 +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +and: source1andDest withImm: imm + codegen and: source1andDest withImm: imm +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +or: src1AndDst with: src2 + ^ codegen or: src1AndDst with: src2 +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +or: source1andDest withImm: imm + codegen or: source1andDest withImm: imm +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftLeft: srcAndDst byImm: count + codegen shiftLeft: srcAndDst byImm: count +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRightArithmetic: srcAndDst by: countReg + codegen shiftRightArithmetic: srcAndDst by: countReg +! ! + +!GenericAssembler methodsFor: 'operations - logical' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRightArithmetic: srcAndDst byImm: count + codegen shiftRightArithmetic: srcAndDst byImm: count +! ! + +!GenericAssembler methodsFor: 'relocation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +applyFixups + codegen memory applyFixupsWith: self +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildFrame + self + push: codegen regFP; + move: codegen regSP to: codegen regFP +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +bytes + ^codegen bytes +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +decRindirect + | memref | + memref := codegen memRef: codegen regR indexImm: 1. + codegen decMem: memref +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +discardArguments: anInteger + anInteger = 0 ifTrue: [^self]. + codegen addImm: anInteger * codegen wordSize to: codegen regSP +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithGindex: index + | memref | + memref := codegen memRef: codegen regG indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithGindex: index + | memref | + memref := codegen memRef: codegen regG indexImm: index. + codegen + load: codegen regM + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSwithGindex: index + | memref | + memref := codegen memRef: codegen regG indexImm: index. + codegen + load: codegen regS + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pop: dstReg + codegen pop: dstReg +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +push: srcReg + codegen push: srcReg + +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushImm: imm + codegen pushImm: imm +! ! + +!GenericAssembler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushIndirectR + | memref | + memref := codegen memRef: codegen regR indexImm: 1. + codegen pushMem: memref +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearFPUFlags + codegen clearFPUFlags +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareEqualDoubleX0withAindirect + codegen compareEqualDoubleX0withAindirect +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compareLessThanDoubleX0withAindirect + codegen compareLessThanDoubleX0withAindirect +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +dropTopOfFPU + codegen dropTopOfFPU +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +leadingRzeroCount + codegen leadingRzeroCount +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadLongMwithIPoffset: anInteger + codegen loadLongMwithIPoffset: anInteger +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMXCSRfromA + codegen loadMXCSRfromA +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByte: dstReg from: srcBaseReg atIndexAt: srcIndexReg + codegen loadZeroExtendByte: dstReg from: srcBaseReg atIndexAt: srcIndexReg + +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByte: dstReg from: srcBaseReg atIndexImm: indexImm + + codegen + loadZeroExtendByte: dstReg + from: srcBaseReg + atIndexImm: indexImm +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendShortRwithRoffset: offset + codegen + loadZeroExtendShortRwithRoffset: offset +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +lock + codegen lock +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +moveTslots + codegen moveTslots +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +readFPUStatusOnA + codegen readFPUStatusOnA +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +scaleFloatOnRWithA + codegen scaleFloatOnRWithA +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeMXCSRintoA + codegen storeMXCSRintoA +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subTslotsToSP + codegen subTslotsToSP +! ! + +!GenericAssembler methodsFor: 'to-cleanup' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +writeTslots + codegen writeTslots +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearRhigh32 + codegen clearHigh32: codegen regR + +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +dec: srcAndDstReg + codegen dec: srcAndDstReg +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +dropTos: count + codegen addImm: (count * codegen addressSize) to: codegen regSP +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inc: srcAndDstReg + codegen inc: srcAndDstReg +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeS + codegen move: codegen regR to: codegen regS +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadEwithAddressOfRatA + | memref | + memref := codegen + memRef: codegen regR + index: codegen regA + offsetImm: codegen wordSize negated. + codegen lea: codegen regE withMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadLargeX0withRindirect + | memref | + memref := codegen memRef64: codegen regR indexImm: 1. + codegen loadDouble: codegen regX0 fromMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadLargeX1withAindirect + | memref | + memref := codegen memRef64: codegen regA indexImm: 1. + codegen loadDouble: codegen regX1 fromMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadLongRwithRatOffsetA + | memref | + memref := codegen + memRef32: codegen regR + offset: codegen regA. + codegen load: codegen regR fromMem: memref + +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadLongSwithRindex: index + | memref | + memref := codegen memRef32: codegen regR indexImm: index. + codegen load: codegen regS fromMem: memref + +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithA + codegen move: codegen regA to: codegen regM +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRconvertingDoublePointedByR + | memref | + memref := codegen memRef64: codegen regR indexImm: 1. + codegen load: codegen regR convertingDoubleToIntegerFromMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithArgPointer + | memref | + memref := codegen memRef: codegen regFP indexImm: 3. + codegen lea: codegen regR withMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSwithAddressOfSatA + | memref | + memref := codegen + memRef: codegen regS + index: codegen regA + offsetImm: codegen wordSize negated. + codegen lea: codegen regS withMem: memref +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadX0withRasDouble + codegen convert: codegen regR toDouble: codegen regX0 +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popA + codegen pop: codegen regA +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popE + codegen pop: codegen regE +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popFP + codegen pop: codegen regFP +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popFalse + codegen pop: codegen regFalse +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popG + codegen pop: codegen regG +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popM + codegen pop: codegen regM +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popNil + codegen pop: codegen regNil +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popR + codegen pop: codegen regR +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popS + codegen pop: codegen regS +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popT + codegen pop: codegen regT +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popTrue + codegen pop: codegen regTrue +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushA + codegen push: codegen regA +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushE + codegen push: codegen regE +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushFP + codegen push: codegen regFP +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushFalse + codegen push: codegen regFalse +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushG + codegen push: codegen regG +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushM + codegen push: codegen regM +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushNil + codegen push: codegen regNil +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushR + codegen push: codegen regR +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushS + codegen push: codegen regS +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushT + codegen push: codegen regT +! ! + +!GenericAssembler methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushTrue + codegen push: codegen regTrue +! ! + +!GenericAssembler methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compare: register withBoolean: aBoolean + aBoolean + ifTrue: [ self compareWithTrue: register ] + ifFalse: [ self compareWithFalse: register ] +! ! + +!GenericAssembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +currentAddress + ^ codegen currentAddress +! ! + +!GenericAssembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +move: srcReg to: dstReg + ^ codegen move: srcReg to: dstReg + +! ! + +!GenericAssembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +moveImm: imm to: dstReg + codegen moveImm: imm to: dstReg + +! ! + +!GenericAssembler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +wordSize + ^codegen wordSize +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +divideDoubleX0byX1 + codegen divDouble: codegen regX0 by: codegen regX1 +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithTIBatR + codegen load: codegen regR withTIBat: codegen regR +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithThreadVariableAtR + codegen load: codegen regR withThreadVariableAt: codegen regR +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +moveX0toR + codegen moveDouble: codegen regX0 into: codegen regR +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +multiplyDoubleX0byX1 + codegen mulDouble: codegen regX0 by: codegen regX1 +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushAatToffset: offset + | memref | + memref := codegen memRef: codegen regA index: codegen regT. + memref displacement: offset. + codegen pushMem: memref +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +renameByteRegisterIfNeeded: register preserving: preserved1 preserving: preserved2 during: aBlock + codegen renameByteRegisterIfNeeded: register preserving: preserved1 preserving: preserved2 during: aBlock +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +roundDoubleX0intoX1 + codegen roundDouble: codegen regX0 into: codegen regX1 +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sqrtDoubleX0 + codegen sqrtDouble: codegen regX0 into: codegen regX0 +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeAinThreadVariableAtIndexR + codegen store: codegen regA intoThreadVariableAt: codegen regR +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeDoubleResultInRindirect + | memref | + memref := codegen memRef: codegen regR indexImm: 1. + codegen storeDoubleResultIntoMem: memref +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeTIBatRwithA + codegen store: codegen regA intoTIBat: codegen regR +! ! + +!GenericAssembler methodsFor: 'floting point' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subDoubleX1fromX0 + codegen subDouble: codegen regX1 from: codegen regX0 +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +extendRtoAandDividebyT + codegen divide: codegen regR extendingTo: codegen regA by: codegen regT +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +multiplyRbyAwideningToA + codegen + multiply: codegen regR + by: codegen regA + wideningTo: codegen regA +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeAinTindex: index + | memref | + memref := codegen memRef: codegen regT indexImm: index. + codegen + store: codegen regA + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeByteAinRindex: index + | memref | + memref := codegen memRef8: codegen regR indexImm: index. + codegen store: codegen regA byte intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeByteTinRatA + | memref | + memref := codegen memRef8: codegen regR index: codegen regA. + codegen store: codegen regT byte intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeEinRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + store: codegen regE + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeLargeX0inA + | memref | + memref := codegen memRef64: codegen regA indexImm: 1. + codegen storeDouble: codegen regX0 intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeLargeX0inT + | memref | + memref := codegen memRef64: codegen regT indexImm: 1. + codegen storeDouble: codegen regX0 intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeLongTinRatA + | memref | + memref := codegen memRef32: codegen regR index: codegen regA. + codegen + store: codegen regT + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeLongTinRatOffsetA + | memref | + memref := codegen memRef32: codegen regR offset: codegen regA. + codegen store: codegen regT long intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeRinAindex: index + | memref | + memref := codegen memRef: codegen regA indexImm: index. + codegen + store: codegen regR + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeRinEindex: index + | memref | + memref := codegen memRef: codegen regE indexImm: index. + codegen + store: codegen regR + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeRinFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + store: codegen regR + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeRinSindex: index + | memref | + memref := codegen memRef: codegen regS indexImm: index. + codegen + store: codegen regR + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeRinTindex: index + | memref | + memref := codegen memRef: codegen regT indexImm: index. + codegen + store: codegen regR + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeShortAinRoffset: offset + | memref | + memref := codegen memRef16: codegen regR offsetImm: offset. + codegen store: codegen regA short intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeShortTinRatOffsetA + | memref | + memref := codegen memRef16: codegen regR offset: codegen regA. + codegen store: codegen regT short intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeSinRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + store: codegen regS + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeTinRatA + | memref | + memref := codegen memRef: codegen regR index: codegen regA. + codegen + store: codegen regT + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeTinRatOffsetA + | memref | + memref := codegen memRef: codegen regR offset: codegen regA. + codegen store: codegen regT intoMem: memref +! ! + +!GenericAssembler methodsFor: 'storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeTinRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + store: codegen regT + intoMem: memref +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfEqualTo: label + codegen jumpIfEqualTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfGreaterOrEqualSignedTo: label + codegen jumpIfGreaterOrEqualSignedTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfGreaterSignedTo: label + codegen jumpIfGreaterSignedTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfLessOrEqualSignedTo: label + codegen jumpIfLessOrEqualSignedTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfLessSignedTo: label + codegen jumpIfLessSignedTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfNotEqualTo: label + codegen jumpIfNotEqualTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfNotZeroTo: label + codegen jumpIfNotZeroTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfOverflowTo: label + codegen jumpIfOverflowTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfSignTo: label + codegen jumpIfSignTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpIfZeroTo: label + codegen jumpIfZeroTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByte: reg1 from: reg2 atOffset: offset + codegen loadZeroExtendByte: reg1 from: reg2 atOffset: offset +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loop: aBlock times: anInteger + | loop | + loop := self newLabel. + self loadTwithImmediate: anInteger; @ loop. + aBlock value. + self dec: codegen regT; shortJumpIfNotZeroTo: loop +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loopTtimes: aBlock + | loop end | + loop := self newLabel. + end := self newLabel. + self + compareTwithImmediate: 0; + @ loop; + shortJumpIfEqualTo: end. + aBlock value. + self + dec: codegen regT; + shortJumpTo: loop; + @ end +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +renameByteRegisterIfNeeded: register preserving: preserved during: aBlock + codegen renameByteRegisterIfNeeded: register preserving: preserved during: aBlock +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +return + codegen return +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfCarryTo: label + codegen shortJumpIfCarryTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfEqualTo: label + codegen shortJumpIfEqualTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfNotCarryTo: label + codegen shortJumpIfNotCarryTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfNotEqualTo: label + codegen shortJumpIfNotEqualTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpIfSignTo: label + codegen shortJumpIfSignTo: label +! ! + +!GenericAssembler methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shortJumpTo: label + codegen shortJumpTo: label +! ! + +!GenericAssembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpTo: label + codegen jumpTo: label +! ! + +!GenericAssembler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpToMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen jumpToMem: memref +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerBitTestOfR + ^self labeledIntegerBitTestOf: codegen regR +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerBitTestOfT + ^self labeledIntegerBitTestOf: codegen regT byte +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerNativizationOfA + ^self labeledIntegerNativizationOf: codegen regA +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerNativizationOfR + ^self labeledIntegerNativizationOf: codegen regR +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledIntegerNativizationOfT + ^self labeledIntegerNativizationOf: codegen regT +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +labeledNonIntegerBitTestOfR + ^self labeledNonIntegerBitTestOf: codegen regR +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithImmediate: imm + self load: codegen regA withImmediate: imm +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithSmallInteger: anInteger + | smi | + smi := (anInteger bitShift: 1) + 1. + self loadAwithImmediate: smi +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithImmediate: imm + self load: codegen regR withImmediate: imm +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithRatA + | memref | + memref := codegen memRef: codegen regR index: codegen regA. + self + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithImmediate: imm + self load: codegen regT withImmediate: imm +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByteRwithRatA + self loadZeroExtendByte: codegen regR from: codegen regR atIndexAt: codegen regA +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByteRwithRindex: index + #dontOptimize. + self loadZeroExtendByte: codegen regR from: codegen regR atIndexImm: index +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByteRwithSPatA + self loadZeroExtendByte: codegen regR from: codegen regSP atIndexAt: codegen regA +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendByteTwithAindex: index + #dontOptimize. + self loadZeroExtendByte: codegen regT from: codegen regA atIndexImm: index +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendLongRwithRatA + | memref | + memref := codegen memRef32: codegen regR index: codegen regA. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'integers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadZeroExtendLongRwithRindex: index + | memref | + #dontOptimize. + memref := codegen memRef32: codegen regR indexImm: index. + codegen + load: codegen regR e + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load: dstReg fromMem: srcMemRef + ^codegen load: dstReg fromMem: srcMemRef +! ! + +!GenericAssembler methodsFor: 'memory - load / store' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +store: srcReg intoMem: dstMemRef + ^ codegen store: srcReg intoMem: dstMemRef +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load:dstReg withImmediate: imm + codegen moveImm: imm to: dstReg +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load: register withLiteral: anObject + | index memref | + index := self addLiteral: anObject. + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: register + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithAindex: index + | memref | + memref := codegen memRef: codegen regA indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithEindex: index + | memref | + memref := codegen memRef: codegen regE indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithFalse + codegen move: codegen regFalse to: codegen regA +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithGlobal: aSymbol + | index | + index := NativizationEnvironment indexOfGlobal: aSymbol. + self loadAwithGindex: index +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithLiteral: anObject + | index | + index := self addLiteral: anObject. + self loadAwithMindex: index +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithNil + codegen move: codegen regNil to: codegen regA +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithR + codegen move: codegen regR to: codegen regA +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithRoffsetAtA + | memref | + memref := codegen memRef + base: codegen regR; + index: codegen regA; + scale: 1. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithS + codegen move: codegen regS to: codegen regA +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithSindex: index + | memref | + memref := codegen memRef: codegen regS indexImm: index. + codegen + load: codegen regA + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadAwithTrue + codegen move: codegen regTrue to: codegen regA +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadEwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regE + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadEwithNil + codegen move: codegen regNil to: codegen regE +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadEwithR + codegen move: codegen regR to: codegen regE +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadFPwithR + codegen move: codegen regR to: codegen regFP +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadFPwithSP + codegen move: codegen regSP to: codegen regFP +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadFalseWithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regFalse + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadGwithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regG + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regM + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regM + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + load: codegen regM + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadMwithTindex: index + | memref | + memref := codegen memRef: codegen regT indexImm: index. + codegen + load: codegen regM + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadNilWithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regNil + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithA + codegen move: codegen regA to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithE + codegen move: codegen regE to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithEindex: index + | memref | + memref := codegen memRef: codegen regE indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithFP + codegen move: codegen regFP to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithFalse + codegen move: codegen regFalse to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithM + codegen move: codegen regM to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithNil + codegen move: codegen regNil to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithRatOffsetA + | memref | + memref := codegen memRef + base: codegen regR; + index: codegen regA; + scale: 1. + codegen + load: codegen regR + fromMem: + memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithS + codegen move: codegen regS to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithSPindex: index + | memref | + memref := codegen memRef: codegen regSP indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithSindex: index + | memref | + memref := codegen memRef: codegen regS indexImm: index. + codegen + load: codegen regR + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithT + codegen move: codegen regT to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadRwithTrue + codegen move: codegen regTrue to: codegen regR +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSPwithFP + codegen move: codegen regFP to: codegen regSP +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regS + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSwithNil + codegen move: codegen regNil to: codegen regS +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadSwithRindex: index + | memref | + memref := codegen memRef: codegen regR indexImm: index. + codegen + load: codegen regS + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTrueWithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regTrue + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithA + codegen move: codegen regA to: codegen regT +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithAindex: index + | memref | + memref := codegen memRef: codegen regA indexImm: index. + codegen + load: codegen regT + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithEindex: index + | memref | + memref := codegen memRef: codegen regE indexImm: index. + codegen + load: codegen regT + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithFPindex: index + | memref | + memref := codegen memRef: codegen regFP indexImm: index. + codegen + load: codegen regT + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithMindex: index + | memref | + memref := codegen memRef: codegen regM indexImm: index. + codegen + load: codegen regT + fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithR + codegen move: codegen regR to: codegen regT +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadTwithTindex: index + | memref | + memref := codegen memRef: codegen regT indexImm: index. + codegen load: codegen regT fromMem: memref +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadWithFalse: register + codegen move: codegen regFalse to: register +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadWithNil: register + codegen move: codegen regNil to: register +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadWithTrue: register + codegen move: codegen regTrue to: register +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +reserveStackSlots: amount + codegen subImm: amount * codegen addressSize from: codegen regSP +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +testIntegerBit: aRegister + codegen testIntegerBit: aRegister +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +testIntegerBitOf: aRegister + codegen test: aRegister byte withImm: 1 +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +testRintegerBit + codegen test: codegen regR byte withImm: 1 +! ! + +!GenericAssembler methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +testRwithR + codegen test: codegen regR with: codegen regR +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef + "Return clean instance of pointer-sized memory reference" + + ^ codegen memRef + +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef: baseReg index: indexReg + ^ codegen memRef: baseReg index: indexReg +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef: baseReg indexImm: indexImm + ^ codegen memRef: baseReg indexImm: indexImm +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef32: baseReg indexImm: indexImm + ^ codegen memRef32: baseReg indexImm: indexImm +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef8 + "Return clean instance of byte-sized memory reference" + + ^ codegen memRef8 +! ! + +!GenericAssembler methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef8: baseReg index: indexReg + ^ codegen memRef8: baseReg index: indexReg +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regA + ^codegen regA + +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regA8 + ^ codegen regA byte + +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regE + ^ codegen regE +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regFP + ^ codegen regFP +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regFalse + ^ codegen regFalse +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regG + ^ codegen regG +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regIP + ^ codegen regIP +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regM + ^ codegen regM +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regNil + ^ codegen regNil +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regR + ^ codegen regR +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regR8 + ^ codegen regR byte +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regS + ^ codegen regS +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regSP + ^ codegen regSP +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regT + ^ codegen regT +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regT8 + ^ codegen reg byte +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regTrue + ^ codegen regTrue +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regV + ^ codegen regV +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regX0 + "IEEE 754 double register" + ^ codegen regX0 +! ! + +!GenericAssembler methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regX1 + "IEEE 754 double register" + ^ codegen regX1 +! ! + +!GenericAssembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +platform: aNativizationPlatform + codegen := aNativizationPlatform newCodeGenerator. + super platform: aNativizationPlatform. +! ! + +!GenericAssembler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +reset + super reset. + codegen reset +! ! + +!GenericAssembler methodsFor: 'epilogue' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +restoreCallerFrame + codegen + move: codegen regFP to: codegen regSP; + pop: codegen regFP +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +add: source1 to: source2andDest + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addImm: imm to: dest + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +and: source1andDest with: source2 + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +and: source1andDest withImm: imm + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +breakpoint + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +call: srcReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearHigh32: srcAndDstReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compare: reg1 with: reg2 + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compare: reg1 withImm: imm + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compare: reg1 withMem: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +convert: src toDouble: dst + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +dec: srcAndDstReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +decMem: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +divDouble: src1andDstReg by: src2reg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +divide: srcAndDstReg extendingTo: extReg by: divisorReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +exchange: srcAndDstReg withMem: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inc: srcAndDstReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpTo: label + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +jumpToMem: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load: dstReg convertingDoubleToIntegerFromMem: srcMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load: dstReg withTIBat: indexReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load: dstReg withThreadVariableAt: indexReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +moveDouble: srcReg into: dstReg + "move from X-type register srcReg into general purpose dstReg" + + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +moveImm: imm to: dstReg + "Load constant to register `dstImm`" + + self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +mulDouble: src1andDstReg by: src2reg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +multiply: src1AndDstLoReg by: src2reg wideningTo: dstHiReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +or: src1andDest withImm: imm + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +reset + memory reset +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftLeft: srcAndDst byImm: count + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRight: srcAndDst byImm: count + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRightArithmetic: srcAndDst by: countReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shiftRightArithmetic: srcAndDst byImm: count + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sqrtDouble: srcReg into: dstReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sub: src1 from: src2AndDst + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subDouble: src1 from: src2AndDst + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subImm: imm from: srcAndDst + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +test: src1Reg with: src2Reg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'basic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +test: srcReg withImm: imm + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'operations - arithmetic' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addDouble: source1 to: source2andDest + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addressBitSize + ^self addressSize * 8 + +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addressLength + ^wordSize * 8 +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addressSize + "Return the size of address in bytes, e.g, 4 for 32bit archs + and 8 for 64bit archs" + + ^wordSize +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +bytes + ^memory bytes +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +callIndirect: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +codeSize + ^memory codeSize +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memory + ^memory +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativeCode + ^ NativeCode new code: memory bytes +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +wordSize + ^wordSize +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +wordSize: anInteger + self ASSERT: anInteger == 8. + wordSize := anInteger. +! ! + +!CodeGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +wordSizeShift + ^wordSize = 8 ifTrue: [3] ifFalse: [2] +! ! + +!CodeGenerator methodsFor: 'alignment' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +alignTo: aNumber + | current count | + current := memory position. + count := (current alignedTo: aNumber) - current. + self nop: count +! ! + +!CodeGenerator methodsFor: 'relocation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +baseAddress + ^memory baseAddress +! ! + +!CodeGenerator methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +bitLengthOf: anInteger + (anInteger between: -16r80 and: 16r7F) ifTrue: [^8]. + (anInteger between: -16r8000 and: 16r7FFF) ifTrue: [^16]. + (anInteger between: -16r80000000 and: 16r7FFFFFFF) ifTrue: [^32]. + (anInteger between: -16r8000000000000000 and: 16r7FFFFFFFFFFFFFFF) + ifTrue: [^64]. + (anInteger + between: -16r80000000000000000000000000000000 + and: 16r7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF) + ifTrue: [^128]. + ^nil +! ! + +!CodeGenerator methodsFor: 'labels' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +currentAddress + ^memory currentAddress +! ! + +!CodeGenerator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + memory := RelocatableBuffer new. +! ! + +!CodeGenerator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +platform: aNativizationPlatform + abi := aNativizationPlatform abi. + wordSize := aNativizationPlatform wordSize. +! ! + +!CodeGenerator methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +stream + ^memory stream +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +lea: dstReg withMem: srcMemRef + ^self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load: dstReg fromMem: srcMemRef + "Load `dstReg` from memory location `srcMemRef`. + The size of data loaded is specified in `srcMemRef`. + + When loading 32bits into 64bit register, high 32bits must be + cleared (in other words, 32bit value is *zero* extended to + 64bits and stored in `dstReg`. + + However, when loading 16bits or 8bits, high 48 or 56 bits + are *left intact*. + + This somewhat weird behavior is heritage of x86. + " + + ^ self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadDouble: dstReg fromMem: srcMemRef + "Load 64-bit floating point `dstReg` from memory location `srcMemRef`" + + ^ self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef: baseReg index: indexRef + ^ self memRef + base: baseReg; + displacement: self addressSize negated; + index: indexRef; + scale: self addressSize; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef: baseReg index: indexRef offsetImm: anInteger + ^ self memRef + base: baseReg; + displacement: anInteger; + index: indexRef; + scale: self addressSize; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef: baseReg indexImm: indexImm + ^ self memRef + base: baseReg; + displacement: (indexImm - 1) * self addressSize; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef: baseReg offset: indexReg + ^ self memRef + base: baseReg; + index: indexReg; + scale: 1; + yourself +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef16 + "Return clean instance of memory reference." + + ^ self memRef length: 16; yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef16: baseReg offset: offsetReg + ^ self memRef16 + base: baseReg; + index: offsetReg; + scale: 1; + yourself +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef16: baseReg offsetImm: offsetImm + ^ self memRef16 + base: baseReg; + displacement: offsetImm; + yourself +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef32 + "Return clean instance of memory reference." + + ^ self memRef length: 32; yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef32: baseReg index: indexReg + ^ self memRef32 + base: baseReg; + displacement: -4; + index: indexReg; + scale: 4; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef32: baseReg indexImm: indexImm + ^ self memRef32 + base: baseReg; + displacement: (indexImm - 1) * 4; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef32: baseReg offset: offsetReg + ^ self memRef32 + base: baseReg; + index: offsetReg; + scale: 1; + yourself +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef64 + "Return clean instance of memory reference." + + ^ self memRef length: 64; yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef64: baseReg indexImm: indexImm + ^ self memRef64 + base: baseReg; + displacement: (indexImm - 1) * 8; + yourself +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef8 + "Return clean instance of memory reference." + + ^ self memRef length: 8; yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef8: baseReg index: indexReg + ^ self memRef8 + base: baseReg; + displacement: -1; + index: indexReg; + scale: 1; + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRef8: baseReg indexImm: indexImm + ^ self memRef8 + base: baseReg; + displacement: (indexImm - 1); + yourself + +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRefAatT +^self memRef: self regA index: self regT +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +memRefSPatT + ^ self memRef: self regSP index: self regT +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +roundDouble: srcReg into: dstReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +store: srcReg intoMem: dstMemRef + "Store `srcReg` into memory location `dstMemRef`. + + The size of data loaded is specified in `dstMemRef`" + ^self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'memory' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +storeDouble: srcReg intoMem: dstMemRef + ^ self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +move: srcReg to: dstReg + ^ self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pop: dstReg + ^ self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +popIntoMem: dstMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +push: srcReg + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushAOnFPUStack + ^ self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushImm: imm + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushMem: aMemRef + self subclassResponsibility +! ! + +!CodeGenerator methodsFor: 'push/pop' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushROnFPUStack + ^ self subclassResponsibility + +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regA + ^abi regA +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regE + ^abi regE +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regFP + ^abi regFP +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regFalse + ^abi regFalse +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regG + ^ abi regG +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regIP + ^abi regIP +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regM + ^abi regM +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regNil + ^abi regNil +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regR + ^abi regR +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regS + ^abi regS +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regSP + ^abi regSP +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regT + ^abi regT +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regTrue + ^abi regTrue +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regV + ^abi regV +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regX0 + ^ abi regX0 +! ! + +!CodeGenerator methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regX1 + ^ abi regX1 +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +clearHigh32: srcAndDstReg + self + shiftLeft: srcAndDstReg byImm: 32; + shiftRight: srcAndDstReg byImm: 32 +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +dec: srcAndDstReg + self addImm: -1 to: srcAndDstReg + +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +decMem: aMemRef + self addImm: -1 toMem: aMemRef + +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inc: srcAndDstReg + self addImm: 1 to: srcAndDstReg + +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pop: srcReg + | memref | + memref := self memRef base: self regSP. + self + load: srcReg fromMem: memref; + addImm: wordSize to: self regSP +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +push: srcReg + | memref | + memref := self memRef base: self regSP; displacement: -8. + self + store: srcReg intoMem: memref; + subImm: wordSize from: self regSP +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pushImm: imm + | memref | + memref := self memRef base: self regSP; displacement: -8. + self moveImm: imm to: self regV; + store: self regV intoMem: memref; + subImm: wordSize from: self regSP +! ! + +!RISCCodeGenerator methodsFor: 'jumps' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +subImm: anInteger from: srcAndDstReg + self addImm: anInteger negated to: srcAndDstReg + +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beAbsolute + absolute := true +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +classBinding + ^source classBinding +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +for: anObject + self target: anObject +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + absolute := false +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isAbsolute + ^absolute +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +printOn: aStream + aStream nextPutAll: 'Ref to '; print: target +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +source: sourceObject + source := sourceObject +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sourceOffset + ^sourceOffset +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sourceOffset: aNumber + sourceOffset := aNumber +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +target + ^target +! ! + +!NativeCodeReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +target: anObject + target := anObject +! ! + +!NativeCodeReference class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +absoluteFor: anObject + ^(self new for: anObject) beAbsolute +! ! + +!NativeCodeReference class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +new + "return an initialized instance" + + ^ self basicNew initialize. + +! ! + +!RelocatableBuffer methodsFor: 'fixups' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addAbsoluteFixup: label + | fixup | + fixup := RelocationFixup absoluteFrom: self currentAddress to: label. + fixups add: fixup +! ! + +!RelocatableBuffer methodsFor: 'fixups' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addRelativeFixup: label size: n + | fixup | + fixup := RelocationFixup relativeFrom: self currentAddress to: label. + fixup size: n. + fixups add: fixup +! ! + +!RelocatableBuffer methodsFor: 'fixups' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +applyFixupsWith: solver + fixups do: [:fixup | fixup patch: self with: solver] +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +baseAddress + ^address +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +bytes + ^stream contents +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +codeSize + ^stream size +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +currentAddress + ^address + stream position +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +peek + ^stream peek +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +peek: n + ^stream peek: n +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +position + ^stream position +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +position: anInteger + stream position: anInteger +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +size + ^stream size +! ! + +!RelocatableBuffer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +skip: anInteger + stream skip: anInteger +! ! + +!RelocatableBuffer methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + fixups := OrderedCollection new. + address := 0. + stream := #[] writeStream +! ! + +!RelocatableBuffer methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +reset + fixups := OrderedCollection new. + stream reset +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextBytePut: byte + | value | + value := byte < 0 ifTrue: [ byte + 256 ] ifFalse: byte. + stream nextBytePut: value +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextBytesPut: aByteArray + stream nextBytesPut: aByteArray +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextLargePut: large + stream nextLargePut: large + +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextLongPut: long + stream nextLongPut: long + +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextPut: byte + stream nextPut: byte +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextPutAll: aByteArray + stream nextPutAll: aByteArray +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextULargePut: large + stream nextULargePut: large + +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextULongPut: long + stream nextULongPut: long +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +stream + ^stream +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +writeByte: byte at: location + | previous value | + previous := stream position. + value := byte < 0 ifTrue: [ byte + 256 ] ifFalse: [ byte ]. + stream + position: location - address; + nextBytePut: value; + position: previous +! ! + +!RelocatableBuffer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +writeLong: long at: location + | previous | + previous := stream position. + stream + position: location - address; + nextLongPut: long; + position: previous +! ! + +!RelocatableBuffer methodsFor: 'relocation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +relocateTo: location with: solver + | delta | + delta := location - address. + address := location. + fixups do: [:fixup | fixup relocateBy: delta]. + self applyFixupsWith: solver +! ! + +!RelocatableBuffer methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +stream: aStream + stream := aStream +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addressSize + ^4 +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beAbsolute + relative := false. + size := self addressSize +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beRelative + relative := true +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +from: address1 to: address2 + source := address1. + target := address2 +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +size: anInteger + size := anInteger +! ! + +!RelocationFixup methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +target + ^target +! ! + +!RelocationFixup methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isRelative + ^relative +! ! + +!RelocationFixup methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +patch: buffer with: solver + | delta address | + address := solver resolveLabel: target. + self ASSERT: address notNil. + relative + ifTrue: [ + delta := address - source - size. + size = 1 + ifTrue: [buffer writeByte: delta at: source] + ifFalse: [buffer writeLong: delta at: source]] + ifFalse: [buffer writeLong: address at: source] +! ! + +!RelocationFixup methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +relocateBy: delta + source := source + delta +! ! + +!RelocationFixup methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +printOn: aStream + aStream + nextPutAll: self class name; + nextPut: $:; + space; + nextPutAll: target printString +! ! + +!RelocationFixup class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +absoluteFrom: source to: target + ^self new beAbsolute; from: source to: target +! ! + +!RelocationFixup class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +relativeFrom: source to: target + ^self new beRelative; from: source to: target +! ! + +!LookupNativizer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +closureMethods + ^ self selectorLookupMethods , self globalLookupMethods + , self otherLookupMethods , nativizer class undermethods + , self sendSiteMethods +! ! + +!LookupNativizer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +globalLookupMethods + | result out global | + result := OrderedCollection new. + result + add: ProtoObject >> #_cachedLookup:; + add: ProtoObject >> #_cachedLookup:in:; + add: Thread metaclass >> #currentGlobalLookup; + add: GlobalDispatchCache metaclass >> #current. + out := #(initialize flushAll: flush:forSpecies: flush:for: flush:for:startingAt:). + global := GlobalDispatchCache methods + reject: [ :m | out includes: m selector ]. + ^ result + addAll: global; + yourself +! ! + +!LookupNativizer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +otherLookupMethods + ^ OrderedCollection new + add: ProtoObject >> #objectAtValid:put:; + add: ProtoObject >> #behavior; + add: CompiledMethod >> #prepareForExecution; + add: CompiledMethod >> #isNativized; + add: CompiledMethod >> #validNativeCodeAddress; + add: CompiledMethod >> #nativeCode; + add: CompiledMethod >> #selector; + add: NativeCode >> #code; + add: NativeCode >> #compiledCode; + add: Species >> #instanceBehavior; + add: Process >> #wantsToStepInto; + yourself +! ! + +!LookupNativizer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +selectorLookupMethods + ^ OrderedCollection new + add: SendSite >> #_lookup:; + add: SendSite >> #_lookup:in:; + add: SendSite >> #_lookup:inDictionary:; + yourself +! ! + +!LookupNativizer methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sendSiteMethods + | sendsite | + ^ #(_dispatchOn: _dispatchOn:startingAt: _dispatchDebuggableOn: _dispatchDebuggableOn:startingAt: sentSelector when:use: beInvoke:using: bePolymorphic isStaticSend monomorphicMap:to: polymorphicMap:to: maxSize reset takeNextFreeMIC takeNextFreePIC) + collect: [ :s | SendSite >> s ] +! ! + +!LookupNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodFor: selector + ^methods detect: [:m | m selector == selector]. + +! ! + +!LookupNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methods + ^methods +! ! + +!LookupNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizeMethods + | environment | + methods := self closureMethods collect: [:m | nativizer compile: m ]. + environment := self newNativizationEnvironment. + methods do: [:m | environment nativize: m] +! ! + +!LookupNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizer: aNativizationEnvironment + nativizer := aNativizationEnvironment +! ! + +!LookupNativizer methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +newNativizationEnvironment + | environment ignored lookup invoke | + environment := NativizationEnvironment new + platform: nativizer platform; + globals: nativizer globals; + optimizedMethods: nativizer optimizedMethods. + ignored := HaltingSend new + filter: #(< <= = > + - * // bitAnd: bitOr: bitXor:). + lookup := LookupLinker new initializeFrom: environment. + lookup + filter: + #(debuggableCopy acquireReferences nativize refreshBlocks doesNotUnderstandSelector: mustBeBoolean class allocateMoreCaches). + invoke := InvokeLinker new + invoker: environment invokeStub; + addMethods: methods. + ^ environment + addLinker: invoke; + addLinker: ignored; + addLinker: lookup; + completeInitialization +! ! + +!IdentifierBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +contents + ^contents +! ! + +!IdentifierBinder methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +keyFor: aString + ^self subclassResponsibility +! ! + +!IdentifierBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +printOn: aStream + self printOn: aStream indent: 0 +! ! + +!IdentifierBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +printOn: aStream indent: anInteger + self subclassResponsibility +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +at: aString + ^contents at: aString ifAbsent: nil +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +at: aString ifAbsentPut: aBlock + ^contents at: aString ifAbsentPut: aBlock +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +at: aString put: aBinding + contents at: aString put: aBinding +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +define: aString as: aBinding + contents at: aString put: aBinding +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +defines: identifier + ^contents includesKey: identifier +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +do: aBlock + contents do: aBlock +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +select: aBlock + ^contents select: aBlock +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +values + ^contents values +! ! + +!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +withIndexDo: aBlock + contents withIndexDo: aBlock +! ! + +!StaticBinder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + contents := OrderedDictionary new +! ! + +!StaticBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +printOn: aStream indent: anInteger + aStream tab: anInteger; nextPut: $<. + contents keys + do: [:name | name printOn: aStream] + separatedBy: [aStream space]. + aStream nextPut: $> +! ! + +!LocalEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isInlinedArgument + ^false +! ! + +!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureType + ^CaptureEnvironmentValue +! ! + +!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +index + ^index +! ! + +!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +index: anInteger + index := anInteger +! ! + +!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isCurrent + ^index isNil +! ! + +!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isIndirect + ^self isCurrent not +! ! + +!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isStack + ^false +! ! + +!StackEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +index + ^nil +! ! + +!StackEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isStack + ^true +! ! + +!ArgumentEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureType + ^CaptureLocalArgument +! ! + +!InlinedArgEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +captureType + ^CaptureInlinedArgument +! ! + +!InlinedArgEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isInlinedArgument + ^true +! ! + +!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inline: aMessageNode + | s keywords | + message := aMessageNode. + message receiver isSuper + ifTrue: [ ^ self ]. + message isCascadeMessage + ifTrue: [ ^ self ]. + s := message selector value. + s == #ifTrue: + ifTrue: [ ^ self inlineConditional ]. + s == #ifFalse: + ifTrue: [ ^ self inlineConditional ]. + s == #or: + ifTrue: [ ^ self inlineConditional ]. + s == #and: + ifTrue: [ ^ self inlineConditional ]. + s == #timesRepeat: + ifTrue: [ ^ self inlineConditional ]. + s == #ifTrue:ifFalse: + ifTrue: [ ^ self inlineConditional ]. + s == #ifFalse:ifTrue: + ifTrue: [ ^ self inlineConditional ]. + s == #andNot: + ifTrue: [ ^ self inlineConditional ]. + s == #orNot: + ifTrue: [ ^ self inlineConditional ]. + s == #ifNil: + ifTrue: [ ^ self inlineConditional ]. + s == #ifNotNil: + ifTrue: [ ^ self inlineIfNotNil ]. + s == #ifNil:ifNotNil: + ifTrue: [ ^ self inlineIfNilIfNotNil ]. + s == #ifNotNil:ifNil: + ifTrue: [ ^ self inlineIfNotNilIfNil ]. + s == #whileTrue: + ifTrue: [ ^ self inlineWhile ]. + s == #whileFalse: + ifTrue: [ ^ self inlineWhile ]. + s == #whileTrue + ifTrue: [ ^ self inlineUnitaryWhile ]. + s == #whileFalse + ifTrue: [ ^ self inlineUnitaryWhile ]. + s == #repeat + ifTrue: [ ^ self inlineRepeat ]. + s == #to:do: + ifTrue: [ ^ self inlineToDo ]. + "s == #to:by:do: + ifTrue: [ ^ self inlineToByDo ]." + keywords := $: split: s. + keywords last = '' + ifTrue: [ keywords := keywords allButLast ]. + (keywords conform: [ :k | k = 'and' ]) + ifTrue: [ ^ self inlineConditional ]. + (keywords conform: [ :k | k = 'or' ]) + ifTrue: [ ^ self inlineConditional ]. + ((keywords allButLast conform: [ :k | k = 'and' ]) + and: [ #('ifTrue' 'ifFalse') includes: keywords last ]) + ifTrue: [ ^ self inlineConditional ]. + ((keywords allButLast conform: [ :k | k = 'or' ]) + and: [ #('ifTrue' 'ifFalse') includes: keywords last ]) + ifTrue: [ self inlineConditional ] +! ! + +!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlineRepeat + | receiver arguments | + receiver := message receiver. + receiver isEvaluable + ifFalse: [ ^ self ]. + arguments := message arguments. + arguments isEmpty + ifFalse: [ ^ self ]. + receiver isBlockNode + ifFalse: [ ^ self ]. + message beInlined. + receiver beInlined +! ! + +!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlineUnitaryWhile + | receiver arguments | + receiver := message receiver. + receiver isEvaluable ifFalse: [^self]. + arguments := message arguments. + arguments size = 0 ifFalse: [^self]. + self inlineConditional. + receiver isBlockNode ifTrue: [ + message beInlined. + receiver beInlined] +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlineConditional + | arguments | + arguments := message arguments. + arguments size >= 1 ifFalse: [^self]. + arguments do: [:arg | arg isEvaluable ifFalse: [^self]]. + message beInlined. + arguments select: #isBlockNode thenDo: #beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlineIfNilIfNotNil + | arguments arg | + arguments := message arguments. + arguments size = 2 ifFalse: [^self]. + arguments first isEvaluable ifFalse: [^self]. + arg := arguments second. + (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) + ifFalse: [^self]. + message beInlined. + arguments select: #isBlockNode thenDo: #beInlined + +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlineIfNotNil + | arguments arg | + arguments := message arguments. + arguments size = 1 ifFalse: [^self]. + arg := arguments first. + (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) + ifFalse: [^self]. + message beInlined. + arg isBlockNode ifTrue: [arg beInlined] +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlineIfNotNilIfNil + | arguments arg | + arguments := message arguments. + arguments size = 2 ifFalse: [^self]. + arguments second isEvaluable ifFalse: [^self]. + arg := arguments first. + (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) + ifFalse: [^self]. + message beInlined. + arguments select: #isBlockNode thenDo: #beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlineToByDo + | arguments arg step | + arguments := message arguments. + arguments size = 3 ifFalse: [^self]. + arg := arguments at: 3. + arg isBlockNode ifFalse: [^self]. + arg arguments size = 1 ifFalse: [^self]. + step := arguments at: 2. + (step isNumberNode and: [step value isSmallInteger]) ifFalse: [^self]. + message beInlined. + arg beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlineToDo + | arguments last | + arguments := message arguments. + arguments size = 2 ifFalse: [^self]. + last := arguments at: 2. + last isBlockNode ifFalse: [^self]. + last arguments size = 1 ifFalse: [^self]. + message beInlined. + last beInlined +! ! + +!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlineWhile + | receiver arguments | + receiver := message receiver. + receiver isEvaluable + ifFalse: [ ^ self ]. + arguments := message arguments. + arguments size = 1 + ifFalse: [ ^ self ]. + arguments last isNullary + ifFalse: [ ^ self ]. + self inlineConditional. + receiver isBlockNode + ifTrue: [ receiver beInlined ] +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ast + ^ast +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ast: aParseNode + ast := aParseNode +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +method + ^method +! ! + +!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +method: aCompiledMethod + method := aCompiledMethod +! ! + +!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beSuccessful + error := nil +! ! + +!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +error + ^error +! ! + +!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +error: aCompilationError + error := aCompilationError +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +canBeInIdentifier: aCharacter + ^aCharacter isLetter or: [aCharacter isDigit] or: [aCharacter = $_] +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +canStartIdentifier: aCharacter + ^aCharacter isLetter or: [aCharacter = $_] +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +peekForIdentifier: aStream + | char next | + char := aStream peek. + (self canBeInIdentifier: char) ifTrue: [ + aStream skip: 1. + ^true]. + char = $. ifFalse: [^false]. + aStream prev isLetter ifFalse: [ + aStream skip: 1. + ^false]. + next := aStream skip: 2; peek. + next isNil ifTrue: [ + aStream skip: -1. + ^false]. + ^next isLetter ifFalse: [aStream skip: -1]; yourself +! ! + +!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +protect: aBlock + ^aBlock value +! ! + +!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +classBinding + ^class +! ! + +!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +classBinding: aSpecies + | instance | + class := aSpecies. + instance := aSpecies instanceClass. + (instance respondsTo: #configureCompiler) + ifTrue: [instance configureCompiler: self] +! ! + +!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize: aDictionary + class := aDictionary at: #UndefinedObject ifAbsent: nil +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compile: aString + result := self smalltalkCompiler compileMethod: aString. + ^result method +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parse: aString + result := self smalltalkCompiler parseMethod: aString. + ^result ast +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +smalltalkCompiler + ^ SSmalltalkCompiler new frontend: self +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +smalltalkParser + ^ self smalltalkCompiler parser +! ! + +!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +smalltalkScanner + ^ self smalltalkCompiler scanner +! ! + +!SCompiler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +forClass: aClass + | c | + c := aClass ifNil: [UndefinedObject]. + self classBinding: c +! ! + +!SCompiler class methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compile: aString in: aClass + | compiler | + compiler := self forClass: aClass. + ^compiler compile: aString +! ! + +!SCompiler class methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parse: aString in: aClass + | compiler | + compiler := self forClass: aClass. + ^compiler parse: aString +! ! + +!SCompiler class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +forClass: aClass + ^self new forClass: aClass +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visit: aParseNode + ^aParseNode notNil ifTrue: [aParseNode acceptVisitor: self] +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitAssignment: anAssignmentNode + ^self visitParseNode: anAssignmentNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitBlock: aBlockNode + ^self visitParseNode: aBlockNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitBraceNode: aBraceNode + ^self visitParseNode: aBraceNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitCascade: aCascadeNode + ^self visitParseNode: aCascadeNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitCascadeMessage: aCascadeMessageNode + ^self visitMessage: aCascadeMessageNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitForeignNode: anForeignNode + self visitLiteral: anForeignNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitIdentifier: anIdentifierNode + ^self visitParseNode: anIdentifierNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitLiteral: aLiteralNode + ^self visitParseNode: aLiteralNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitMessage: aMessageNode + ^self visitParseNode: aMessageNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitMethod: aMethodNode + ^self visitParseNode: aMethodNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitNumberNode: aNumberNode + ^self visitLiteral: aNumberNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitParseNode: aParseNode + ^self subclassResponsibility +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitPragma: aPragmaNode + ^self visitParseNode: aPragmaNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitReturn: aReturnNode + ^self visitParseNode: aReturnNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitSelector: aSelectorNode + ^self visitParseNode: aSelectorNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitString: aStringNode + ^self visitLiteral: aStringNode +! ! + +!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitSymbolicPragma: aPragmaNode + ^self visitPragma: aPragmaNode +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +analyzeAssignment: anAssignmentNode + anAssignmentNode assignees + do: [:v | self analyzeIdentifier: v assignee: true] +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +analyzeBlock: aBlockNode while: aBlock + aBlockNode isInlined + ifFalse: [aBlockNode index: aBlockNode compiler blockIndex]. + self analyzeScript: aBlockNode while: aBlock +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +analyzeIdentifier: anIdentifierNode + self analyzeIdentifier: anIdentifierNode assignee: false +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +analyzeIdentifier: anIdentifierNode assignee: aBoolean + | script binding | + anIdentifierNode resolveAssigning: aBoolean. + aBoolean ifTrue: [anIdentifierNode beAssigned]. + script := anIdentifierNode compiler activeScript. + binding := anIdentifierNode binding. + script reference: binding. + binding isLocal ifTrue: [binding := script scope captureLocal: binding]. + anIdentifierNode binding: binding +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +analyzeMessage: aMessageNode + inliner inline: aMessageNode. + aMessageNode isInlined ifFalse: [aMessageNode compiler noticeSend] +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +analyzeMethod: aMethodNode while: aBlock + self analyzeScript: aMethodNode while: aBlock +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +analyzeReturn: aReturnNode + aReturnNode compiler activeScript realScript captureHome +! ! + +!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +analyzeScript: aScriptNode while: aBlock + aScriptNode compiler activate: aScriptNode while: aBlock +! ! + +!SSemanticVisitor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + inliner := MessageInliner new +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitAssignment: anAssignmentNode + self analyzeAssignment: anAssignmentNode. + anAssignmentNode expression acceptVisitor: self +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitBlock: aBlockNode + self + analyzeBlock: aBlockNode + while: [aBlockNode statements do: [:node | node acceptVisitor: self]] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitBraceNode: aBraceNode + aBraceNode isLiteral + ifFalse: [aBraceNode asMessageNode acceptVisitor: self] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitCascade: aCascadeNode + aCascadeNode receiver acceptVisitor: self. + aCascadeNode messages do: [:msg | msg acceptVisitor: self] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitIdentifier: anIdentifierNode + self analyzeIdentifier: anIdentifierNode +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitMessage: aMessageNode + self analyzeMessage: aMessageNode. + aMessageNode receiver acceptVisitor: self. + aMessageNode arguments do: [:arg | arg acceptVisitor: self] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitMethod: aMethodNode + self analyzeMethod: aMethodNode while: [ + aMethodNode bindLocals. + aMethodNode statements do: [:s | s acceptVisitor: self]. + aMethodNode positionLocals] +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitParseNode: aParseNode + " + do nothing + " + +! ! + +!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitReturn: aReturnNode + aReturnNode expression acceptVisitor: self. + self analyzeReturn: aReturnNode +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compiledBlockIndexOf: aBlockNode + | index | + index := method + findFirst: [:literal | literal isBlock + and: [literal blockNumber == aBlockNode index]]. + ^index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeArgument: anInteger env: environment + | encoded | + encoded := self encodedEnvironment: environment. + self + nextPut: ArgumentId; + nextIntegerPut: anInteger; + nextIntegerPut: encoded +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeClosureElements: aBlockNode + | scope parent | + scope := aBlockNode scope. + parent := aBlockNode realParent. + ^Array streamContents: [:s | + scope capturesSelf ifTrue: [ s nextPut: CaptureSelf ]. + scope capturedEnvironments do: [:e | | index | + e == parent ifTrue: [s nextPut: CaptureEnvironment] ifFalse: [ + index := aBlockNode environmentIndexOf: e. + self ASSERT: index notNil. + s nextPut: CaptureEnvironmentValue; nextPut: index]]. + scope capturedArguments do: [:a | | binding | + binding := aBlockNode parent scope resolve: a name. + s nextPut: binding environmentCaptureType; nextPut: binding index]] + +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeDynamicVar: name + stream nextPut: DynamicVarId. + self nextSymbolPut: name +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeFalse + stream nextPut: FalseId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeLoadRvisitingReceiver + stream nextPut: LoadRvisitingReceiverId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeNestedDynamicVar: name + stream nextPut: NestedDynamicVarId. + self nextLiteralPut: name +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeNil + stream nextPut: NilId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodePopR + stream nextPut: PopRid +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodePushR + stream nextPut: PushRid +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeSelf + stream nextPut: SelfId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeSuper + stream nextPut: SuperId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeTemporary: anInteger env: environment + | encoded | + encoded := self encodedEnvironment: environment. + self + nextPut: TemporaryId; + nextIntegerPut: anInteger; + nextIntegerPut: encoded +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeTrue + stream nextPut: TrueId +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodedEnvironment: aLocalEnvironment + aLocalEnvironment isStack + ifTrue: [ ^ aLocalEnvironment isInlinedArgument + ifTrue: [ -1 ] + ifFalse: [ -2 ] ]. + aLocalEnvironment isCurrent + ifTrue: [ ^ 0 ]. + ^ aLocalEnvironment index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextBigIntegerPut: anInteger + stream + nextPut: 16r80; + nextInt64Put: anInteger +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextBooleanPut: aBoolean + stream nextPut: aBoolean asParameter + +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextIntegerPut: anInteger + | value | + (anInteger > 127 or: [ anInteger < -127 ]) + ifTrue: [ ^ self nextBigIntegerPut: anInteger ]. + value := anInteger >= 0 + ifTrue: [ anInteger ] + ifFalse: [ anInteger + 16r100 ]. + stream nextPut: value +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextLiteralPut: anObject + | index | + index := method + indexOf: anObject + ifAbsent: [ self ASSERT: false ]. + self nextIntegerPut: index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextPut: anInteger + stream nextPut: anInteger +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextPutAll: aCollection + stream nextPut: aCollection size; nextPutAll: aCollection +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextSymbolPut: aSymbol + | index | + index := method + indexOf: aSymbol asSymbol + ifAbsent: [ self ASSERT: false ]. + self nextIntegerPut: index +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextTypePut: anInteger + stream nextPut: anInteger +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitAssignment: anAssignmentNode + | assignees | + self nextTypePut: AssignmentId. + assignees := anAssignmentNode assignees. + self nextIntegerPut: assignees size. + assignees do: [ :node | node acceptVisitor: self ]. + anAssignmentNode expression acceptVisitor: self +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitBlock: aBlockNode + | args inlined | + self nextTypePut: BlockId. + inlined := aBlockNode isInlined. + self nextBooleanPut: inlined. + inlined + ifTrue: [ args := aBlockNode arguments collect: [ :id | id binding index ]. + self nextPutAll: args asArray ] + ifFalse: [ | index captured | + index := self compiledBlockIndexOf: aBlockNode. + self nextPut: index. + captured := self encodeClosureElements: aBlockNode. + self nextPutAll: captured ]. + self visitScript: aBlockNode +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitBraceNode: aBraceNode + aBraceNode isLiteral + ifTrue: [self visitLiteral: aBraceNode asLiteralNode] + ifFalse: [self visitCascade: aBraceNode asMessageNode] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitCascade: aCascadeNode + | messages | + self nextTypePut: CascadeId. + aCascadeNode receiver acceptVisitor: self. + messages := aCascadeNode messages. + self nextIntegerPut: messages size. + messages do: [ :node | self visitCascadeMessage: node ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitCascadeMessage: aCascadeMessageNode + | arguments | + self nextSymbolPut: aCascadeMessageNode selector symbol. + arguments := aCascadeMessageNode arguments. + self nextIntegerPut: arguments size. + arguments do: [ :arg | arg acceptVisitor: self ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitIdentifier: anIdentifierNode + self nextTypePut: IdentifierId. + anIdentifierNode binding encodeUsing: self +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitLiteral: aLiteralNode + | index | + index := method indexOf: aLiteralNode value. + self + nextTypePut: LiteralId; + nextIntegerPut: index. + index = 0 + ifTrue: [ self nextIntegerPut: aLiteralNode value ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitMessage: aMessageNode + | arguments | + self + nextTypePut: MessageId; + nextBooleanPut: aMessageNode isInlined; + nextSymbolPut: aMessageNode selector symbol. + aMessageNode receiver acceptVisitor: self. + arguments := aMessageNode arguments. + self nextIntegerPut: arguments size. + arguments do: [ :arg | arg acceptVisitor: self ] +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitMethod: aMethodNode + | pragma | + self nextTypePut: MethodId. + pragma := aMethodNode pragma. + pragma isUsed + ifTrue: [ self nextTypePut: PragmaId. + pragma name + ifNotNil: [ self nextSymbolPut: pragma name ] + ifNil: [ self nextPut: 0 ] ]. + self visitScript: aMethodNode. + ^ stream contents +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitParseNode: aParseNode + ^self ASSERT: false +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitReturn: aReturnNode + self + nextTypePut: ReturnId; + nextBooleanPut: script realScript isMethod. + + aReturnNode expression acceptVisitor: self +! ! + +!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +visitScript: aScriptNode + | prev statements | + prev := script. + script := aScriptNode. + statements := aScriptNode statements. + self nextIntegerPut: statements size. + statements do: [ :node | node acceptVisitor: self ]. + script := prev +! ! + +!TreecodeEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + stream := #[] writeStream +! ! + +!TreecodeEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +method: aCompiledMethod + method := aCompiledMethod +! ! + +!TreecodeEncoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeBindingIds + | named | + named := self addNamespaceAs: #BindingIds. + named + at: #NilId put: 1; + at: #TrueId put: 2; + at: #FalseId put: 3; + at: #ArgumentId put: 4; + at: #TemporaryId put: 5; + at: #SelfId put: 6; + at: #SuperId put: 7; + at: #DynamicVarId put: 14; + at: #NestedDynamicVarId put: 15; + at: #PushRid put: 50; + at: #PopRid put: 51 +! ! + +!TreecodeEncoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeTreecodeIds + | named | + named := self addNamespaceAs: #TreecodeIds. + named + at: #MethodId put: 101; + at: #BlockId put: 102; + at: #IdentifierId put: 103; + at: #LiteralId put: 104; + at: #MessageId put: 105; + at: #CascadeId put: 106; + at: #BraceId put: 107; + at: #AssignmentId put: 108; + at: #ReturnId put: 109; + at: #PragmaId put: 110 +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +capturesSelf + ^ captureSelf +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +describe: identifier + | binding type | + binding := self resolve: identifier. + type := self class name asLowercase allButLast: 'scope' size. + ^binding description , ' of ' , type +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentSize + ^envSize +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +scopeOf: aString + | s | + s := self scriptDefining: aString. + ^s notNil ifTrue: [s scope] +! ! + +!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +stackSize + ^stackSize +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +defineArgument: identifier + | binding | + (self resolves: identifier) ifTrue: [self redefinitionError: identifier]. + binding := ArgumentBinding new name: identifier. + arguments define: identifier as: binding. + ^binding +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +defineTemporary: identifier + | binding | + (temporaries defines: identifier) + ifTrue: [self redefinitionError: identifier]. + binding := TemporaryBinding new name: identifier. + temporaries define: identifier as: binding. + ^binding +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +defines: aString + ^(temporaries defines: aString) or: [arguments defines: aString] +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +localBindings + ^arguments values , temporaries values +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +resolveLocal: aString + (temporaries at: aString) ifNotNil: [:binding | ^binding]. + ^arguments at: aString +! ! + +!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +resolves: aString + ^(self resolve: aString) isDynamic not +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +growEnvironment + ^envSize := envSize + 1 +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +growStack + ^stackSize := stackSize + 1 +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionDefinedArguments + arguments withIndexDo: [:binding :index | binding index: index] +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionDefinedLocals + self positionDefinedTemporariesIn: self; positionDefinedArguments +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionDefinedTemporariesIn: aScriptScope + temporaries do: [:binding | | position | + position := binding isInStack + ifTrue: [aScriptScope growStack] + ifFalse: [aScriptScope growEnvironment]. + binding index: position] +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionLocals + self positionDefinedLocals +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +realScope + ^script realScript scope +! ! + +!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +redefinitionError: name + | scope description | + scope := self scopeOf: name. + description := scope describe: name. + script compiler + warning: name , ' already declared as ' , description + at: script stretch +! ! + +!ScriptScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + arguments := StaticBinder new. + temporaries := StaticBinder new. + stackSize := envSize := 0. + captureSelf := false. +! ! + +!ScriptScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +script: aScriptNode + script := aScriptNode +! ! + +!ScriptScope class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +on: aScriptNode + ^self new script: aScriptNode +! ! + +!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureArgument: anArgumentBinding + | name | + name := anArgumentBinding name. + ^captured at: name ifAbsentPut: [| transferred copy | + transferred := self parent transferLocal: name. + copy := self copyLocal: transferred. + copy declaration: transferred declaration] +! ! + +!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +localBindings + ^super localBindings , captured values +! ! + +!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +resolve: aString + (self resolveLocal: aString) ifNotNil: [:binding | ^binding]. + ^self parent resolve: aString +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureEnvironment: aScriptNode + script == aScriptNode ifTrue: [^self]. + (environments includesIdentical: aScriptNode) ifTrue: [^self]. + self realParent captureEnvironment: aScriptNode. + aScriptNode isMethod + ifTrue: [environments addFirst: aScriptNode] + ifFalse: [environments addLast: aScriptNode] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +capturedEnvironmentIndexOf: aScriptNode + | index | + aScriptNode realScript == script realScript + ifTrue: [ ^ nil ]. + index := environments indexOf: aScriptNode ifAbsent: nil. + self ASSERT: index notNil. + ^self capturesSelf ifTrue: [ index + 1 ] ifFalse: [ index ] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +copyLocal: binding + ^script isInlined ifTrue: [binding] ifFalse: [binding copy beInArray] +! ! -!ObjectReference commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentIndexOf: aScriptNode + " + temporal compatibility + " + (aScriptNode isKindOf: SScriptNode) + ifFalse: [ self ASSERT: false. ^nil ]. + ^self capturedEnvironmentIndexOf: aScriptNode +! ! -!Species commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentSizeUpToCapturedArguments + ^self environmentSizeUpToEnvironments + self capturedArguments size +! ! -!StarToken commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentSizeUpToEnvironments + | receiver | + receiver := self capturesSelf ifTrue: [ 1 ] ifFalse: [ 0 ]. + ^receiver + environments size +! ! -!Stretch commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parent + ^script parent scope +! ! -!StringPattern commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionCapturedArgument: anArgumentBinding + anArgumentBinding index: self growEnvironment +! ! -!Unicode commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionCapturedLocals + script isInlined ifTrue: [^self]. + envSize := self environmentSizeUpToEnvironments. + captured do: [:binding | + binding isArgument + ifTrue: [self positionCapturedArgument: binding] + ifFalse: [self positionCapturedTemporary: binding]] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionCapturedTemporary: aTemporaryBinding + | outest index declaration | + outest := self scriptDefining: aTemporaryBinding name. + index := self capturedEnvironmentIndexOf: outest realScript. + aTemporaryBinding environmentIndex: index. + declaration := outest scope resolve: aTemporaryBinding name. + self ASSERT: declaration index isInteger. + aTemporaryBinding index: declaration index +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionDefinedArgumentsIn: aScriptScope + arguments do: [:binding | | index | + index := binding isInArray + ifTrue: [aScriptScope growEnvironment] + ifFalse: [aScriptScope growStack]. + binding index: index] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionDefinedLocals + | real | + script isInlined + ifTrue: [ + real := self realScope. + self + positionDefinedTemporariesIn: real; + positionDefinedArgumentsIn: real] + ifFalse: [super positionDefinedLocals] +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionLocals + self positionCapturedLocals. + super positionLocals +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +realParent + ^script realParent scope +! ! + +!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +transferLocal: name + | binding copy | + (self resolveLocal: name) ifNotNil: [:b | ^b]. + binding := self parent transferLocal: name. + copy := self copyLocal: binding. + captured at: name put: copy. + ^copy +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureLocal: aLocalBinding + (self defines: aLocalBinding name) ifTrue: [^aLocalBinding]. + ^aLocalBinding isTemporary + ifTrue: [self captureTemporary: aLocalBinding] + ifFalse: [self captureArgument: aLocalBinding] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureSelf + captureSelf ifTrue: [^self]. + captureSelf := true. + self parent captureSelf +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureTemporary: aTemporaryBinding + | name | + name := aTemporaryBinding name. + (self defines: name) ifTrue: [^aTemporaryBinding]. + ^captured at: name ifAbsentPut: [| parent declaration transferred copy | + parent := self parent. + declaration := parent scriptDefining: name. + self realScope captureEnvironment: declaration realScript. + transferred := parent transferLocal: name. + copy := self copyLocal: transferred. + copy isInArray ifTrue: [aTemporaryBinding beInArray]. + copy declaration: transferred declaration] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +capturedArguments + ^captured select: [:b | b isArgument] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +capturedEnvironments + ^environments +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +capturesHome + ^self home notNil +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environments + " + compatibility, removes the home environment + " + | first | + environments isEmpty ifTrue: [^#()]. + first := environments first. + ^first isMethod ifTrue: [environments allButFirst] ifFalse: [environments] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +home + | first | + environments isEmpty ifTrue: [^nil]. + first := environments first. + ^first isMethod ifTrue: [first] +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +resolveLocal: aString + (super resolveLocal: aString) ifNotNil: [:binding | ^binding]. + ^captured at: aString +! ! + +!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +scriptDefining: aString + (self defines: aString) ifTrue: [^script]. + ^self parent scriptDefining: aString +! ! + +!BlockScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + captured := StaticBinder new. + environments := OrderedCollection new +! ! + +!MethodScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureEnvironment: aScriptNode + self ASSERT: aScriptNode == script +! ! + +!MethodScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +transferLocal: name + ^self resolveLocal: name +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureLocal: aLocalBinding + self ASSERT: (self resolveLocal: aLocalBinding name) notNil. + ^aLocalBinding +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureSelf + captureSelf := true. + +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentIndexOf: aScriptNode + self ASSERT: aScriptNode == script. + ^nil +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +resolve: aString + (self resolveLocal: aString) ifNotNil: [ :binding | ^ binding ]. + (self resolvePseudo: aString) ifNotNil: [ :binding | ^ binding ]. + ^ DynamicBinding named: aString +! ! + +!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +scriptDefining: aString + (self resolveLocal: aString) ifNotNil: [^script]. + self ASSERT: false. + ^nil +! ! + +!MethodScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + self initializePseudoVars +! ! + +!MethodScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializePseudoVars + pseudo := StaticBinder new. + pseudo + at: 'nil' put: NilBinding new; + at: 'true' put: TrueBinding new; + at: 'false' put: FalseBinding new; + at: 'self' put: SelfBinding new; + at: 'super' put: SuperBinding new +! ! + +!MethodScope methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +resolvePseudo: aString + ^pseudo at: aString + +! ! + +!Binding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beReferencedFrom: aScriptNode + +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +canBeAssigned + ^true +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +declaration + ^self +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeUsing: aTreecodeEncoder + self ASSERT: false +! ! + +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isArgument + ^false +! ! -!UTF16 commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isClassBinding + ^false +! ! -!UTF32 commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isClassVariable + ^false +! ! -!UTF8 commentStamp: '' prior: 0! -Copyright (c) 2020 Aucerna. - See (MIT) license in root directory. -! +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isConstantBinding + ^false +! ! -!ModuleLoader commentStamp: '' prior: 0! -Copyright (c) 2024 Quorum Software. - See (MIT) license in root directory. -! +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isDynamic + ^false +! ! -!ModuleSpecReader commentStamp: '' prior: 0! -Copyright (c) 2024 Quorum Software. - See (MIT) license in root directory. -! +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isGlobal + ^false +! ! -!MessageInlinerTest commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isInStack + ^false +! ! -!SmalltalkScannerTest commentStamp: '' prior: 0! -Copyright (c) 2026, Javier Pimás. - See (MIT) license in root directory. -! +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isInstVar + ^false +! ! -!LMRClosure commentStamp: '' prior: 0! -Copyright (c) 2022, Javier Pimás. - See (MIT) license in root directory. -! +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isLiteral + ^false +! ! -!LMRProtoObject commentStamp: '' prior: 0! -Copyright (c) 2022, Javier Pimás. - See (MIT) license in root directory. -! +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isLocal + ^false +! ! -!LMRSpecies commentStamp: '' prior: 0! -Copyright (c) 2022, Javier Pimás. - See (MIT) license in root directory. -! +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isPoolVariableBinding + ^false +! ! -!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! -arguments: aCollection - self replaceFrom: 1 to: aCollection size with: aCollection +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isSelf + ^false ! ! -!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! -callingConvention: anInteger - self at: self size put: anInteger +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isSelfOrSuper + ^self isSelf or: [self isSuper] ! ! -!SFFIDescriptor methodsFor: 'calls' stamp: 'KenD 28/Jun/2026 13:27:40'! -return: anInteger - self at: self size - 1 put: anInteger +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isSuper + ^false ! ! -!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - self initializeFFITypes; initializeCallingConventions +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isTemporary + ^false ! ! -!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initializeCallingConventions - FFICallingConventions := Dictionary new. - FFICallingConventions - at: 'cdecl' put: 20; - at: 'com' put: 21; - at: 'callback' put: 22 +!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +literal + ^nil ! ! -!SFFIDescriptor class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initializeFFITypes - FFITypes := Dictionary new. - FFITypes - at: 'uint8' put: 0; - at: 'sint8' put: 1; - at: 'uint16' put: 2; - at: 'sint16' put: 3; - at: 'uint32' put: 4; - at: 'sint32' put: 5; - at: 'uint64' put: 6; - at: 'sint64' put: 7; +!Binding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name + ^name +! ! - at: 'float' put: 8; - at: 'double' put: 9; +!Binding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name: aString + name := aString +! ! - at: 'uchar' put: 10; - at: 'schar' put: 11; - at: 'ushort' put: 12; - at: 'sshort' put: 13; - at: 'ulong' put: 14; - at: 'slong' put: 15; - at: 'ularge' put: 16; - at: 'large' put: 17; - at: 'longdouble' put: 18; - at: 'pointer' put: 19; - at: 'complex-float' put: 20; - at: 'complex-double' put: 21; - at: 'complex-longdouble' put: 22; +!Binding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +printNameOn: aStream + aStream + print: name - at: 'void' put: 23 ! ! -!SFFIDescriptor class methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! -ret: aString args: aCollection cc: ccName - | args return cc result | - args := aCollection - collect: [ :argname | - FFITypes - at: argname asString - ifAbsent: [ self error: 'undefined argument type ' , argname ] ]. - return := FFITypes - at: aString - ifAbsent: [ self error: 'undefined result type ' , aString ]. - cc := FFICallingConventions - at: ccName - ifAbsent: [ self error: 'unsupported calling convention ' , ccName ]. - result := self new: args size + 2. - ^ result - callingConvention: cc; - return: return; - arguments: args +!Binding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +printOn: aStream + self printNameOn: aStream. + aStream + nextPutAll: ' ('. + super printOn: aStream. + aStream nextPutAll: ')' ! ! -!LMRSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -flushCacheFor: species - GlobalDispatchCache current flush: self forSpecies: species. - SendSite flush: self +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beReferencedFrom: aScriptNode + "a dynamic binding could refer to an ivar, so we have to be conservative" + aScriptNode useSelf ! ! -!WideSymbol methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! -<= aString - ^UTF16 current isString: self lessThanOrEqualTo: aString +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeDynamicVar: name ! ! -!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -asByteCharacters - | n result | - n := self size. - result := Symbol new: n. - 1 to: n do: [:i | | code char | - code := self codeAt: i. - char := code < 256 ifTrue: [code] ifFalse: [$? asInteger]. - result byteAt: i put: char]. - ^result +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isDynamic + ^true ! ! -!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -asLowercase - ^UTF16 current lowercaseOf: self +!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +literal + ^name asSymbol ! ! -!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -asString - | n string | - n := self size. - string := WideString new: n. - ^string replaceFrom: 1 to: n with: self +!DynamicBinding class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +default + ^Default ifNil: [Default := self new name: ''] ! ! -!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -asUppercase - ^UTF16 current uppercaseOf: self +!DynamicBinding class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +named: aString + | index first second | + index := aString indexOf: $.. + index = 0 ifTrue: [ ^self new name: aString ]. + first := aString copyFrom: 1 to: index - 1. + second := aString copyFrom: index + 1 to: aString size. + ^NestedDynamicBinding new name: { first. second } ! ! -!WideSymbol methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -asWideSymbol - ^self +!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeNestedDynamicVar: name ! ! -!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -at: index - | cp | - cp := self checkIndex: index; codeAt: index. - ^Character value: cp +!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +literal + ^name collect: [ :n | n asSymbol] ! ! -!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -at: index putCode: codePoint - ^self - checkIndex: index; - uLongAtOffset: index - 1 * 4 put: codePoint +!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +printNameOn: aStream + name do: [ :n | aStream nextPutAll: n ] separatedBy: [ aStream nextPut: $. ] ! ! -!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -atValid: index - | cp | - cp := self codeAt: index. - ^Character value: cp +!LiteralBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isLiteral + ^true ! ! -!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -size - ^self _size // 4 +!FalseBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeFalse ! ! -!WideSymbol methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -sizeInBytes - ^self size * 4 +!FalseBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name + ^'false' ! ! -!WideSymbol methodsFor: 'unassigned' stamp: 'KenD 28/Jun/2026 13:27:38'! -basicSize - ^self _size +!FalseBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +value + ^false ! ! -!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -codeAt: index - ^self uLongAtOffset: index - 1 * 4 +!NilBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeNil ! ! -!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -species - ^WideString +!NilBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +name + ^'nil' ! ! -!WideSymbol methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -td1 - | m td1 | - m := self size. - td1 := Dictionary new: m. - m to: 1 by: -1 do: [:i | | code | - code := self uLongAtOffset: i - 1 * 4. - td1 at: code + 1 ifAbsentPut: [m - i + 1]]. - ^td1 +!NilBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +value + ^nil ! ! -!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isByteCompliant - ^false +!TrueBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeTrue +! ! + +!TrueBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name + ^'true' ! ! -!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isWide +!TrueBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +value ^true ! ! -!WideSymbol methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isWideSymbol - ^true +!LocalBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beInArray + environment := ArrayEnvironment new ! ! -!WideSymbol class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -findInterned: aString - | symbol string | - string := aString reduced. - string == aString ifFalse: [^super findInterned: string]. - symbol := aString bytes changeClassTo: self. - ^SymbolTable lookup: symbol +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +declaration + ^declaration ! ! -!WideSymbol class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -intern: aString - | symbol canonical | - aString isByteCompliant ifTrue: [^aString reduced asSymbol]. - symbol := aString bytes changeClassTo: self. - canonical := SymbolTable lookup: symbol. - canonical == nil ifTrue: [^SymbolTable add: symbol]. - ^canonical +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +declaration: anIdentifierNode + declaration := anIdentifierNode ! ! -!WideString methodsFor: 'operations' stamp: 'KenD 28/Jun/2026 13:27:38'! -, aString - | n string | - aString isString ifFalse: [^super , aString]. - n := self size. - string := WideString new: n + aString size. - ^string - replaceBytesFrom: 1 to: self sizeInBytes with: self startingAt: 1; - replaceFrom: n + 1 to: string size with: aString startingAt: 1 +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environment + ^environment index ! ! -!WideString methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! -<= aString - ^UTF16 current isString: self lessThanOrEqualTo: aString +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentCaptureType + ^environment captureType ! ! -!WideString methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! -hash - | hash | - hash := self size. - 0 - to: self sizeInBytes - 4 - by: 4 - do: [:i | hash := (hash hashMultiply: 16r19660D) - bitXor: (self uLongAtOffset: i)]. - ^hash +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentIndex + ^environment index ! ! -!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -asByteCharacters - | n result | - n := self size. - result := String new: n. - 1 to: n do: [:i | | code char | - code := self codeAt: i. - char := code < 256 ifTrue: [code] ifFalse: [$? asInteger]. - result byteAt: i put: char]. - ^result +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentIndex: anInteger + environment index: anInteger ! ! -!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -asLowercase - ^UTF16 current lowercaseOf: self +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentObject + ^environment ! ! -!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -asSymbol - ^WideSymbol intern: self +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +index + ^index ! ! -!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -asUppercase - ^UTF16 current uppercaseOf: self +!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +index: aNumber + index := aNumber ! ! -!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -asWideString - ^self +!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isInArray + ^self isInStack not ! ! -!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -existingSymbol - ^WideSymbol findInterned: self +!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isInStack + ^environment isStack ! ! -!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -reduced - ^self isByteCompliant ifTrue: [self asByteCharacters] ifFalse: [self] +!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isLocal + ^true ! ! -!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -sizeInBytes - ^self basicSize +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beInlined + environment := InlinedArgEnvironment new ! ! -!WideString methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:38'! -utf8Bytes - ^UTF8 current encode: self +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +description + ^'argument ' , name ! ! -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -at: index - | cp | - cp := self checkIndex: index; codeAt: index. - ^Character value: cp +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeUsing: aTreecodeEncoder + aTreecodeEncoder encodeArgument: index env: environment ! ! -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -at: index putCode: codePoint - ^self - checkIndex: index; - uLongAtOffset: index - 1 * 4 put: codePoint +!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isInlined + ^environment isInlinedArgument ! ! -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -atValid: index - | cp | - cp := self codeAt: index. - ^Character value: cp +!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +canBeAssigned + ^false ! ! -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -atValid: anInteger put: aCharacter - self at: anInteger putCode: aCharacter codePoint. - ^aCharacter -! ! +!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +index: aNumber + index := aNumber. -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -atValid: index putCode: codePoint - ^self uLongAtOffset: index - 1 * 4 put: codePoint ! ! -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -checkByteIndex: index - index isInteger ifFalse: [self error: 'strings are indexed by integers']. - (index between: 1 and: self sizeInBytes) - ifFalse: [self - error: 'index: ' , index printString , ' is outside of string bounds'] +!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isArgument + ^true ! ! -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -codeAt: index - ^self uLongAtOffset: index - 1 * 4 +!ArgumentBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + environment := ArgumentEnvironment new ! ! -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromCodePoints: aCollection - 1 to: aCollection size do: [:i | | ci | - ci := aCollection at: i. - self at: i putCode: ci] +!TemporaryBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +description + ^'temporary ' , name ! ! -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -indexAt: anInteger - ^anInteger +!TemporaryBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeUsing: aTreecodeEncoder + aTreecodeEncoder encodeTemporary: index env: environment ! ! -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -primitiveULongAtOffset: offset -put: anInteger - offset _isSmallInteger ifFalse: [^self outOfBoundsIndex: offset]. - (0 <= offset and: [offset + 3 <= self _size]) - ifFalse: [^self outOfBoundsIndex: offset]. - ^self uLongAtValidOffset: offset put: anInteger +!TemporaryBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + environment := StackEnvironment new ! ! -!WideString methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -td1 - | m td1 | - m := self size. - td1 := Dictionary new: m. - m to: 1 by: -1 do: [:i | | code | - code := self codeAt: i. - td1 at: code + 1 ifAbsentPut: [m - i + 1]]. - ^td1 +!TemporaryBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isTemporary + ^true ! ! -!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -at: anInteger put: aCharacter - self - checkCharacter: aCharacter; - at: anInteger putCode: aCharacter codePoint. - ^aCharacter +!SelfBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beReferencedFrom: aScriptNode + aScriptNode useSelf ! ! -!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -basicAt: anInteger - ^self basicByteAt: anInteger +!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +canBeAssigned + ^false ! ! -!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -basicAt: anInteger put: anObject - ^self basicByteAt: anInteger put: anObject +!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeSelf ! ! -!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -basicSize - ^self _size +!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isSelf + ^true ! ! -!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -byteAt: anInteger - anInteger _isSmallInteger ifFalse: [^self error: 'Non integer index']. - (1 <= anInteger and: [anInteger <= self _size]) - ifFalse: [^self outOfBoundsIndex: anInteger]. - ^self _byteAt: anInteger +!SelfBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name + ^'self' ! ! -!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -byteAt: position put: asciiValue - position _isSmallInteger ifFalse: [^self error: 'Non integer index']. - (1 <= position and: [position <= self _size]) - ifFalse: [^self outOfBoundsIndex: position]. - (0 <= asciiValue and: [asciiValue < 256]) - ifFalse: [^self error: 'invalid character']. - ^self _byteAt: position put: asciiValue +!SuperBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +encodeUsing: aTreecodeEmitter + aTreecodeEmitter encodeSuper ! ! -!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -characterSize - ^4 +!SuperBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name + ^'super' ! ! -!WideString methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -size - ^self basicSize // 4 +!SuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isSelf + ^false ! ! -!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -composeCharacters - ^UTF16 current compose: self +!SuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isSuper + ^true ! ! -!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -decomposeCharacters - ^UTF16 current decompose: self +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +activate: aScriptNode while: aBlock + | current | + current := activeScript. + activeScript := aScriptNode. + aBlock value. + activeScript := current ! ! -!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -foldDigits - ^UTF16 current foldDigitsOf: self +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +activeScope + ^activeScript scope ! ! -!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -normalizeToC - ^UTF16 current normalizeToC: self +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +activeScript + ^activeScript ! ! -!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -normalizeToD - ^(UTF16 current normalizeToD: self) reduced +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +activeScript: aParseNode + activeScript := aParseNode ! ! -!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -normalizeToKC - ^UTF16 current normalizeToKC: self +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ast + ^ast ! ! -!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -normalizeToKD - ^UTF16 current normalizeToKD: self +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +frontend + ^frontend ! ! -!WideString methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -unaccented - ^self normalizeToD reject: [:ch | ch isNonSpacingMark] +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +frontend: aCompiler + frontend := aCompiler ! ! -!WideString methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:38'! -indexOfString: aString from: start to: stop td1: anArray - | m k | - m := aString size. - m = 0 ifTrue: [^0]. - k := start. - [k + m - 1 <= stop] whileTrue: [| i code delta | - i := 1. - [i <= m and: [(aString at: i) = (self at: k + i - 1)]] - whileTrue: [i := i + 1]. - i > m ifTrue: [^k]. - k + m > stop ifTrue: [^0]. - code := self codeAt: k + m. - delta := anArray at: code + 1 ifAbsent: nil. - delta isNil ifTrue: [delta := m + 1]. - k := k + delta]. - ^0 +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parser + ^SSmalltalkParser new compiler: self ! ! -!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isByteCompliant - 1 to: self size do: [:i | | char | - char := self at: i. - char isByteCharacter ifFalse: [^false]]. - ^true +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +result + ^result ! ! -!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isCNormal - ^UTF16 current isCNormal: self +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +scanner + ^SSmalltalkScanner new compiler: self ! ! -!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isDNormal - ^UTF16 current isDNormal: self +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sourceCode + ^source ! ! -!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isKCNormal - ^UTF16 current isKCNormal: self +!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sourceCode: aString + source := aString ! ! -!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isKDNormal - ^UTF16 current isKDNormal: self +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assignmentNode + ^SAssignmentNode new compiler: self ! ! -!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isWide - ^true +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +blockNode + ^SBlockNode new compiler: self ! ! -!WideString methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isWideString - ^true +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +braceNode + ^SBraceNode new compiler: self ! ! -!WideString methodsFor: 'inquires' stamp: 'KenD 28/Jun/2026 13:27:38'! -length - ^UTF16 current lengthOf: self +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildMethod + result method: ast buildMethod ! ! -!WideString methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! -printChunkOn: aStream from: anInteger - ^self printUTF8ChunkOn: aStream from: anInteger +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +cascadeMessageNode + ^SCascadeMessageNode new compiler: self ! ! -!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! -replace: anInteger with: aString - 1 to: anInteger do: [:i | | char | - char := aString at: i. - self at: i put: char] +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +cascadeNode + ^SCascadeNode new compiler: self ! ! -!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! -replaceFirst: anInteger with: aString - 1 to: anInteger do: [:i | | char | - char := aString at: i. - self at: i put: char] +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +commentNode + ^SCommentNode new compiler: self ! ! -!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! -replaceFrom: start to: stop with: aString startingAt: position - | string | - string := self replacementFrom: aString. - super - replaceFrom: start - 1 * 4 + 1 - to: stop * 4 - with: string - startingAt: position - 1 * 4 + 1 +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compileMethod: aString + source := aString. + frontend protect: [ + self + parseMethod; + resolveSemantics; + buildMethod]. + ^result ! ! -!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! -replaceFrom: start to: stop withObject: aCharacter - self checkIndex: start; checkIndex: stop. - start to: stop do: [:i | self at: i put: aCharacter] +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +delimiterToken + ^SDelimiterToken new compiler: self ! ! -!WideString methodsFor: 'replacing' stamp: 'KenD 28/Jun/2026 13:27:38'! -replacementFrom: aString - | n wide | - aString class == self class ifTrue: [^aString]. - aString isExternalMemory ifTrue: [^WideString fromMemory: aString]. - n := aString size. - wide := WideString new: n. - 1 to: n do: [:i | | ch | - ch := aString atValid: i. - wide atValid: i put: ch]. - ^wide +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +endToken + ^SEndToken new compiler: self ! ! -!WideString methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! -uLongAtValidOffset: offset put: anInteger - anInteger size > 4 ifTrue: [self error: 'does not fit in 32 bits']. - self _uLongAtOffset: offset put: anInteger. - ^anInteger +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasBlocks + ^ blocks > 0 ! ! -!WideString class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! -basicNew: anInteger - ^self primitiveNewBytes: anInteger +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasSends +^ leaf not ! ! -!WideString class methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! -new: anInteger - ^self basicNew: anInteger * 4 +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +identifierNode + ^SIdentifierNode new compiler: self ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromBytes: aByteArray - ^UTF16 current - decodeStringFrom: aByteArray readStream - on: (self new: aByteArray size) +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + self reset + ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromCodePoints: aCollection - | string | - string := self new: aCollection size. - ^string fromCodePoints: aCollection +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +literalNode + ^SLiteralNode new compiler: self ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromExternalUTF16: anExternalMemory - ^UTF16 current decodeStringFrom: anExternalMemory readStream +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +messageNode + ^SMessageNode new compiler: self ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromExternalUTF16: anExternalMemory length: anInteger - | stream | - stream := anExternalMemory readStream. - stream readLimit: anInteger. - ^UTF16 current decodeStringFrom: stream +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodNode + ^SMethodNode new compiler: self ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromExternalUTF8: anExternalMemory - ^UTF8 current decodeStringFrom: anExternalMemory readStream +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +noticeSend + leaf := false ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromMemory: anExternalMemory - | s i | - s := self new: 1. - i := 1. - [ - s replaceBytesFrom: 1 to: 2 with: anExternalMemory startingAt: i. - (s codeAt: 1) = 0] - whileFalse: [i := i + 2]. - ^self fromMemory: anExternalMemory length: i - 1 // 2 +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +numericLiteralNode + ^SNumberNode new compiler: self ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromMemory: anExternalMemory length: anInteger - | bytes | - bytes := anExternalMemory readStream readLimit: anInteger * 2. - ^UTF16 current decodeStringFrom: bytes on: (self new: anInteger) +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pragmaNode + ^SPragmaNode new compiler: self ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromMultiByte: aByteArray codePage: anInteger - " - WideString fromMultiByte: #[16rFA] codePage: 1251 - " - | bytes string | - bytes := aByteArray externalCopy. - string := self - fromMultiByteAddress: bytes - codePage: anInteger - size: aByteArray sizeInBytes. - bytes free. - ^string +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +reset + self resetResult. + leaf := true. + blocks := 0. ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromString: aString - aString class == String ifTrue: [^aString asWideString]. - aString class == self ifTrue: [^aString]. - ^self fromUTF8: aString asString utf8 +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +returnNode + ^SReturnNode new compiler: self ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -fromUTF8: aByteArray - ^UTF8 current - decodeStringFrom: aByteArray readStream - on: (self new: aByteArray size) +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +selectorNode + ^SSelectorNode new compiler: self ! ! -!WideString class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -stringFromMemory: anExternalMemory - | s i | - s := self new: 1. - i := 1. - [ - s replaceBytesFrom: 1 to: 2 with: anExternalMemory startingAt: i. - (s codeAt: 1) = 0] - whileFalse: [i := i + 2]. - ^UTF16 decodeFromAddress: anExternalMemory length: i - 1 // 2 +!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +stringToken + ^SStringToken new compiler: self ! ! -!WideString class methodsFor: 'gs' stamp: 'KenD 28/Jun/2026 13:27:38'! -newFrom: aByteArray - ^aByteArray copy changeClassTo: self +!SSmalltalkCompiler methodsFor: 'emitting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +blockCount + ^blocks ! ! -!WideString class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -stringsFromAddress: anExternalMemory - | strings memory | - strings := OrderedCollection new. - memory := anExternalMemory. - [(memory at: 1) = 0 and: [(memory at: 2) = 0]] whileFalse: [| s | - s := self stringFromMemory: memory. - strings add: s. - memory := memory + (s size + 1 * 2)]. - ^strings +!SSmalltalkCompiler methodsFor: 'emitting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +blockIndex + blocks := blocks + 1. + ^blocks - 1 ! ! -!CharacterArray methodsFor: 'converting' stamp: 'KenD 29/Jun/2026 12:12:21'! -dosToUnix - ^self species streamContents: [:s | | source | - source := self readStream. - [source atEnd] whileFalse: [| c | - c := source next. - (c = `Character cr`) - ifTrue: [ - s nextPut: `Character lf`. - source next] - ifFalse: [s nextPut: c]]]! ! +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compilationError: aString stretch: aStretch + ^SCompilationError new + compiler: self; + stretch: aStretch; + description: aString +! ! -!CharacterArray methodsFor: 'converting' stamp: 'KenD 29/Jun/2026 12:11:33'! -unixToMac - | result | - result := self species new: self size. - self - withIndexDo: [:c :i | (c = `Character lf`) - ifTrue: [result at: i put: `Character cr`] - ifFalse: [result at: i put: c]]. - ^result! ! +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +error: aString at: anInteger + | stretch | + stretch := anInteger thru: anInteger. + ^self error: aString stretch: stretch +! ! -!LMRCharacterArray methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -primitiveSize - ^self _size +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +error: aString stretch: aStretch + | error | + error := self compilationError: aString stretch: aStretch. + ^error beFatal; signal ! ! -!Namespace methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! -_namespaceLookup: aSymbol - | table | - table := namespace _basicAt: 2. - 2 - to: table _size - do: [:j | | assoc | - assoc := (table _basicAt: j). - assoc == nil ifFalse: [ - assoc key == aSymbol - ifTrue: [^table _basicAt: j + 1]]]. - ^nil +!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +warning: aString at: aStretch + | error | + error := self compilationError: aString stretch: aStretch. + error beWarning; signal +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parseFragment + headless := false. + self reset. + ast := self parser methodFragment. + result ast: ast +! ! + +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parseFragment: aString + source := aString. + [self parseFragment; resolveSemantics] on: SCompilationError do: []. + ^ast ! ! -!Namespace class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -new - ^super new +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parseMethod + headless := false. + self reset. + ast := self parser method. + result ast: ast ! ! -!WeakIdentityDictionary methodsFor: 'adding' stamp: 'KenD 28/Jun/2026 13:27:38'! -add: anAssociation - self ASSERT: anAssociation class == Ephemeron. - ^self critical: [super add: anAssociation] +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parseMethod: aString + source := aString. + frontend protect: [self parseMethod; resolveSemantics]. + ^result ! ! -!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -associationClass - ^Ephemeron new registry: self +!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +resolveSemantics + ast acceptVisitor: SSemanticVisitor new ! ! -!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -critical: aBlock - | save | - save := critical. - critical := true. - ^[aBlock value] ensure: [critical := save] +!SSmalltalkCompiler methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +resetResult + result := SCompilationResult new compiler: self ! ! -!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -equates: element with: ephemeron - ^element == ephemeron key +!SSmalltalkCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +supportsBraceNodes + ^true ! ! -!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -hashFor: element - ^element basicHash +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addBodyTo: aMethodNode + self + addTemporariesTo: aMethodNode; + addPragmaTo: aMethodNode; + addStatementsTo: aMethodNode ! ! -!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -keyCollector - ^IdentitySet new: self size +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addStatementsTo: aMethodNode + aMethodNode + position: token position; + addStatements: self statements; + end: token position; + moveCommentsFrom: token. + token isEnd + ifFalse: [^self unexpectedStatementError: aMethodNode statements] ! ! -!WeakIdentityDictionary methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -rescue: anEphemeron - critical - ifTrue: [anEphemeron activate] - ifFalse: [self removeKey: anEphemeron key ifAbsent: nil] +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addTemporariesTo: aMethodNode + aMethodNode temporaries: self temporaries ! ! -!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! -associationsDo: aBlock - self critical: [ - super associationsDo: [:ephemeron | | hold | - hold := ephemeron key. - hold notNil ifTrue: [aBlock value: ephemeron]]] +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +cascadeSequence: aMessageNode + | cascade receiver messages msg node | + (token is: $;) ifFalse: [^aMessageNode]. + cascade := self buildNode: compiler cascadeNode at: aMessageNode position. + receiver := aMessageNode receiver. + cascade receiver: receiver. + node := compiler cascadeMessageNode from: aMessageNode. + node cascade: cascade. + messages := OrderedCollection with: node. + [token is: $;] whileTrue: [ + self step. + msg := self buildCascadeMessageNode: receiver. + msg + cascade: cascade; + position: token position; + moveCommentsFrom: token. + messages add: msg. + self cascadeMessage: msg]. + ^cascade messages: messages asArray; end: msg end ! ! -!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! -do: aBlock - self associationsDo: [:assoc | aBlock evaluateWith: assoc value] +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +expression + | primary expression | + (token isNameToken and: [self peek isAssignment]) ifTrue: [^self assignment]. + primary := self primary ifNil: [^self missingExpression]. + expression := self unarySequence: primary. + expression := self binarySequence: expression. + expression := self keywordSequence: expression. + expression == primary + ifFalse: [expression := self cascadeSequence: expression]. + token endsExpression ifFalse: [self errorIn: primary]. + ^expression ! ! -!WeakIdentityDictionary methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! -ephemeronsDo: aBlock - self associationsDo: aBlock +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +keywordSignature + | selector arguments node | + selector := '' writeStream. + arguments := OrderedCollection new. + node := self buildNode: compiler selectorNode at: token position. + [token isKeyword] whileTrue: [ + selector nextPutAll: token value. + node addKeyword: token asSelectorNode. + self step. + token isNameToken ifFalse: [self missingArgument]. + arguments add: token asIdentifierNode. + self step]. + arguments isEmpty ifTrue: [^nil]. + node + symbol: selector contents; + end: token end; + moveCommentsFrom: token. + ^self buildMethodNode: node arguments: arguments ! ! -!WeakIdentityDictionary methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! -onTable: aHashTable - critical := false. - super onTable: aHashTable +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodPragma + self step. + ^[| method | + method := self methodSignature. + self addTemporariesTo: method; attachPragmaTo: method. + method pragma] + on: SCompilationError + do: [:ex | ex return: compiler pragmaNode] ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -beFatal - resumable := retryable := false +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodSignature + self keywordSignature ifNotNil: [:m | ^m]. + self binarySignature ifNotNil: [:m | ^m]. + self unarySignature ifNotNil: [:m | ^m]. + self error: 'method signature expected' ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -beResumable - resumable := true +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parenthesizedExpression + | start open expression | + start := token position. + open := self step. + expression := self expression. + expression moveCommentsFrom: open. + (token is: $)) ifFalse: [self missingToken: ')']. + expression isImmediate + ifFalse: [expression position: start; end: token position]. + self step. + ^expression ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -beWarning - resumable := true +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +primary + token isNameToken ifTrue: [^self step asIdentifierNode]. + token isLiteral ifTrue: [^self step]. + (token is: $[) ifTrue: [^self block]. + (token is: $() ifTrue: [^self parenthesizedExpression]. + (token is: #'#(') ifTrue: [^self literalArray]. + (token is: #'#[') ifTrue: [^self literalByteArray]. + (compiler supportsBraceNodes and: [token is: ${]) ifTrue: [^self bracedArray]. + (token is: #'-') ifTrue: [^self negativeNumber]. + (token is: #'<') ifTrue: [^self taggedNode]. + ^nil ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -compiler - ^compiler +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +return + | return expression end node | + return := self step. + expression := self expression. + expression moveCommentsFrom: token. + end := token position. + self skipDots. + node := self buildNode: compiler returnNode at: return position. + ^node + return: return; + end: end; + expression: expression; + moveCommentsFrom: return ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -compiler: aCompiler - compiler := aCompiler. - compiler result error: self +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +statement + | expression | + ((token is: $^) or: [token is: $↑]) ifTrue: [^self return]. + expression := self expression. + token moveCommentsTo: expression. + ^expression ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -description: aString - description := aString +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +statements + | statements | + statements := OrderedCollection new. + [ + token endsExpression ifTrue: [^statements]. + statements add: self statement. + token is: $.] + whileTrue: [self skipDots]. + ^statements ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isResumable - ^resumable +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +step + | save comments | + save := token. + self next isComment ifFalse: [^save]. + comments := OrderedCollection new: 2. + [ + comments add: token. + self next isComment] whileTrue. + token comments: comments. + ^save +! ! +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +temporaries + | temporaries | + (token is: #'||') ifTrue: [ + self step. + ^#()]. + token isBar ifFalse: [^#()]. + temporaries := OrderedCollection new. + [ + self step. + token isNameToken] + whileTrue: [ + self validateLocalName: token. + temporaries add: token asIdentifierNode]. + token isBar ifFalse: [self missingToken: '|']. + self step. + ^temporaries ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -proceed - retryable := false. - compiler result beSuccessful. - self isResumable ifTrue: [ self resume ] ifFalse: [ self return ] +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +unaryMessage: aMessageNode + | selector | + selector := self unarySelector. + aMessageNode + selector: selector; + end: selector end; + arguments: #(); + moveCommentsFrom: selector ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -source - ^compiler sourceCode copyFrom: stretch start to: stretch end +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +unarySelector + | selector start end node | + selector := token value. + start := token position. + end := start + selector size - 1. + self step. + node := self buildNode: compiler selectorNode at: start. + ^node + symbol: selector; + end: end; + moveCommentsFrom: token ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -stretch - ^stretch +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +unarySequence: aParseNode + | node receiver | + node := aParseNode. + node isNameToken ifTrue: [node := node asIdentifierNode]. + [ + receiver := node. + self hasUnarySelector] + whileTrue: [ + node := self buildMessageNode: receiver. + self unaryMessage: node]. + ^node moveCommentsFrom: token ! ! -!SCompilationError methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -stretch: aStretch - stretch := aStretch +!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +unarySignature + self hasUnarySelector ifFalse: [^nil]. + ^self buildMethodNode: self unarySelector arguments: #() ! ! -!SCompilationError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isUndeclaredAccess - ^false +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addByteTo: aCollection + | byte | + byte := token isLiteral ifTrue: [token value] ifFalse: [token literalValue]. + byte isInteger ifFalse: [self nonIntegerToken]. + (byte between: 0 and: 255) ifFalse: [self invalidByteValue]. + aCollection add: byte ! ! -!SCompilationError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isUndeclaredAssignment - ^ false +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assignment + | position variable delimiter expression assignment | + position := token position. + variable := self step asIdentifierNode moveCommentsFrom: token. + delimiter := self step. + expression := self expression. + expression isAssign + ifTrue: [^expression assign: variable operator: delimiter]. + expression moveCommentsFrom: token. + assignment := self buildNode: compiler assignmentNode at: position. + ^assignment assign: variable with: expression operator: delimiter ! ! -!SUndeclaredIdentifierError methodsFor: 'accessing-token' stamp: 'KenD 28/Jun/2026 13:27:40'! -assignment: aBoolean - assigned := aBoolean +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +attachPragmaTo: aMethodNode + | start pragma | + (aMethodNode isHeadless orNot: [token is: #'<']) ifTrue: [^false]. + start := token position. + self step. + pragma := token isKeyword + ifTrue: [self ffiOrPrimitive: aMethodNode] + ifFalse: [self symbolicPragma]. + pragma position: start; end: token position. + aMethodNode pragma: pragma. + (token is: #'>') ifFalse: [self missingToken: '>']. + ^true ! ! -!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -identifier - ^ identifier +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildBraceNode: elements at: position + | node | + node := self buildNode: compiler braceNode at: position. + ^node elements: elements ! ! -!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isUndeclaredAccess - ^assigned not +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildCascadeMessageNode: receiver + | node | + node := self buildNode: compiler cascadeMessageNode at: receiver position. + ^node receiver: receiver ! ! -!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isUndeclaredAssignment - ^assigned +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildMessageNode: receiver + | node | + node := self buildNode: compiler messageNode at: receiver position. + ^node receiver: receiver ! ! -!SUndeclaredIdentifierError methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -stretch: aStretch - super stretch: aStretch. - identifier := self source +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildMethodNode: selector arguments: arguments + | node | + node := self buildNode: compiler methodNode at: selector position. + compiler activeScript: node. + ^node selector: selector; arguments: arguments ! ! -!ArgParser methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:37'! -addCommand: aCommand - commands at: aCommand name put: aCommand +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildNode: aParserNode at: anInteger + ^aParserNode position: anInteger; end: token position ! ! -!ArgParser methodsFor: 'options' stamp: 'KenD 28/Jun/2026 13:27:37'! -addGlobalOption: anOption - globalOptions add: anOption +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildNode: aParseNode at: anInteger with: anObject + | node | + node := scanner buildToken: aParseNode at: anInteger with: anObject. + ^node end: token position ! ! -!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -description - ^description +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +cascadeMessage: aMessageNode + | msg | + self hasUnarySelector ifTrue: [^self unaryMessage: aMessageNode]. + self hasBinarySelector ifTrue: [^self binaryMessage: aMessageNode]. + self hasKeywordSelector ifTrue: [^self keywordMessage: aMessageNode]. + msg := token value = '' + ifTrue: ['unfinished cascade'] + ifFalse: [token value asString , ' not allowed in cascade']. + self error: msg ! ! -!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -description: aString - description := aString +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ffiArguments + | args type | + args := OrderedCollection new. + self step. + token value !!= $( + ifTrue: [ self error: 'expected "("' ]. + self peek value = $) + ifTrue: [ self step. + ^ args ]. + [ type := self ffiType. + args add: type. + self step. + token value = #, ] whileTrue. + token value !!= $) + ifTrue: [ self error: 'expected ")"' ]. + ^ args ! ! -!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -name - ^name +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ffiCall: aBoolean method: aMethodNode + | cc return name args descriptor | + cc := token value. + return := self ffiType. + aBoolean + ifTrue: [ self step. + name := token value ifNil: [ self error: 'invalid function name' ] ]. + args := self ffiArguments. + args size = aMethodNode selector arity + ifFalse: + [ ^ self error: 'method arity does not match with function arguments' ]. + self step. + descriptor := SFFIDescriptor ret: return args: args cc: cc. + ^ compiler pragmaNode ffi: cc name: name with: descriptor ! ! -!ArgParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -name: aString - name := aString +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ffiOrPrimitive: aMethodNode + | tag | + tag := token value asLowercase. + tag last = $: ifFalse: [self invalidPragma]. + tag := tag allButLast. + token value: tag. + tag = 'primitive' ifTrue: [^self primitive]. + tag = 'callback' ifTrue: [ ^self ffiCall: false method: aMethodNode ]. + tag = 'callout' ifTrue: [ ^self ffiCall: true method: aMethodNode ]. + self invalidPragma ! ! -!ArgParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! -extractGlobalArgs: args - | remaining i | - remaining := OrderedCollection new. - i := 1. - [i <= args size] whileTrue: [ - | arg match rest | - arg := args at: i. - match := globalOptions detect: [:opt | opt matches: arg] ifNone: [nil]. - match ifNotNil: [ - match hasValue ifTrue: [i := i + 1] - ] ifNil: [ - rest := args copyFrom: i to: args size. - ^remaining addAll: rest; yourself]. - i := i + 1]. - ^remaining +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ffiType + | type | + self step. + token isNameToken ifFalse: [self error: 'expected type name']. + type := token value. + type = 'struct' ifFalse: [ ^type]. + self step. + token isNameToken ifFalse: [self error: 'expected type name']. + ^token value ! ! -!ArgParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! -parse: args - | remaining key command result tail | - remaining := self extractGlobalArgs: args. - remaining isEmpty ifTrue: [self printHelp. ^nil]. - key := remaining first. - command := commands at: key ifAbsent: [ - self error: 'Unknown command: ', key, '. Run with no args for help.']. - result := ParseResult new. - result command: key. - tail := remaining copyFrom: 2 to: remaining size. - command parse: tail into: result. - command action ifNotNil: [:act | act value: result]. - ^result +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasKeywordSelector + ^token isKeyword ! ! -!ArgParser methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! -initialize - commands := OrderedDictionary new. - globalOptions := OrderedCollection new +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasUnarySelector + ^token isNameToken ! ! -!ArgParser methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! -printHelp - | text | - text := name ifNil: ['command']. - description ifNotNil: [ - text := text , ' - ' , description]. - text := text , String cr , String cr , 'Commands:' , String cr. - commands keysAndValuesDo: [:key :cmd | - text := text , ' ' , key. - cmd description ifNotNil: [:d | - text := text , ' - ' , d]. - text := text , String cr]. - Kernel log: text +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +invalidPragma + | position stretch | + position := token position. + stretch := position thru: position. + ^SInvalidPragmaError new stretch: stretch; signal ! ! -!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -action - ^action +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +keywordArgument + | arg | + arg := self primary ifNil: [self missingArgument]. + arg := self unarySequence: arg. + ^self binarySequence: arg ! ! -!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -action: aBlock - action := aBlock +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +keywordMessage: aMessageNode + | selector arguments node | + node := self buildNode: compiler selectorNode at: token position. + selector := '' writeStream. + arguments := OrderedCollection new. + [token isKeyword] whileTrue: [ + selector nextPutAll: token value. + node addKeyword: self step. + arguments add: self keywordArgument]. + node symbol: selector contents; end: token prevPosition. + aMessageNode + arguments: arguments; + end: token prevPosition; + selector: node ! ! -!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -description - ^description +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +keywordSequence: aParseNode + | expression | + self hasKeywordSelector ifFalse: [^aParseNode]. + expression := self buildMessageNode: aParseNode. + self keywordMessage: expression. + ^expression ! ! -!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -description: aString - description := aString +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +literalKeyword + | keyword | + keyword := token value , scanner nextKeyword value. + ^keyword reduced asSymbol ! ! -!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -name - ^name +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +namedPrimitive + | name pragma | + token isNameToken + ifFalse: [ self invalidPragma ]. + name := token value. + pragma := self buildNode: compiler pragmaNode at: token position. + ^ pragma primitive: 0 name: name asSymbol ! ! -!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -name: aString - name := aString +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +negativeNumber + token := nil. + ^self negativeNumberOrBinary; step ! ! -!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -options - ^options +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +numberedPrimitive + | number pragma | + number := token value. + number isInteger ifFalse: [self invalidPragma]. + pragma := self buildNode: compiler pragmaNode at: token position. + ^pragma primitive: number name: nil ! ! -!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -positionalNames - ^positionalNames +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +primitive + | primitive | + self step. + primitive := token isNumberNode + ifTrue: [self numberedPrimitive] + ifFalse: [self namedPrimitive]. + self step. + ^primitive ! ! -!Command methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -subcommands - ^subcommands +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +pseudoLiteralValue + | value | + token isPoolLiteral ifTrue: [^token literalValue]. + value := token value. + value = 'nil' ifTrue: [^nil]. + value = 'true' ifTrue: [^true]. + value = 'false' ifTrue: [^false]. + ^token isPoolLiteral ifTrue: [token literalValue] ifFalse: [value asSymbol] ! ! -!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! -addOption: anOption - options add: anOption +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +skipDots + [token is: $.] whileTrue: [self step] ! ! -!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! -addPositional: aString - positionalNames add: aString +!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +validateLocalName: aSmalltalkToken + aSmalltalkToken isDelimitedIdentifier ifTrue: [^self]. + (aSmalltalkToken value includes: $.) + ifTrue: [self error: 'invalid embedded dot'] ! ! -!Command methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! -addSubcommand: aCommand - subcommands at: aCommand name put: aCommand +!SSmalltalkParser methodsFor: 'api support' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addPragmaTo: aMethodNode + (self attachPragmaTo: aMethodNode) ifTrue: [self step] ! ! -!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! -applyDefaults: aResult - options do: [:opt | - (aResult hasOption: opt name) ifFalse: [ - opt defaultValue ifNotNil: [:v | - aResult setOption: opt name to: v]]] +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +arrayBody + | literals position | + literals := OrderedCollection new. + position := token position. + [ + self step. + (token is: $)) or: [token isEnd]] + whileFalse: [| element | + element := self arrayElement. + literals add: element]. + token isEnd ifTrue: [self missingToken: ')']. + ^self buildNode: compiler literalNode at: position with: literals asArray ! ! -!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! -checkRequired: aResult - options do: [:opt | - | name | - name := opt long ifNil: [opt short]. - (opt required and: [(aResult hasOption: opt name) not]) - ifTrue: [self error: 'Required option missing: ', name]] +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +arrayElement + token isLiteral ifTrue: [^token value]. + token isNameToken ifTrue: [^self pseudoLiteralValue]. + token isKeyword ifTrue: [^self literalKeyword]. + (token is: #'-') ifTrue: [^self negativeNumberOrBinary]. + token hasSymbol ifTrue: [^token value]. + (token is: $() ifTrue: [^self arrayBody value]. + (token is: #'#(') ifTrue: [^self arrayBody value]. + (token is: #'#[') ifTrue: [^self byteArrayBody value]. + self invalidArrayToken ! ! -!Command methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! -findOption: aString - ^options detect: [:opt | opt matches: aString] ifNone: [nil] +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +braceBody + | elements position | + elements := OrderedCollection new. + position := token position. + self step. + [ + token isEnd ifTrue: [self missingToken: '}']. + token is: $}] + whileFalse: [ + elements add: self expression. + (token is: $.) ifTrue: [self step]]. + ^self buildBraceNode: elements at: position ! ! -!Command methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! -hasSubcommands - ^subcommands notEmpty +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +bracedArray + | array | + array := self braceBody. + self step. + ^array ! ! -!Command methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! -initialize - options := OrderedCollection new. - positionalNames := OrderedCollection new. - subcommands := OrderedDictionary new +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +byteArrayBody + | bytes save start array node | + bytes := OrderedCollection new. + save := token. + start := token position. + [ + self step. + token isLiteral or: [token isPoolLiteral]] + whileTrue: [self addByteTo: bytes]. + (token is: $]) ifFalse: [ + token isNameToken + ifTrue: [self missingLiteral] + ifFalse: [self missingToken: ']']]. + array := ByteArray new: bytes size. + bytes withIndexDo: [:b :i | array at: i put: b]. + node := self buildNode: compiler literalNode at: start with: array. + ^node moveCommentsFrom: save ! ! -!Command methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! -parse: args into: result - | i | - i := 1. - [i <= args size] whileTrue: [ - | arg | - arg := args at: i. - (arg first = $-) - ifTrue: [i := self parseOption: arg from: args at: i into: result] - ifFalse: [result addPositional: arg]. - i := i + 1]. - self checkRequired: result. - self applyDefaults: result +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +literalArray + | array | + array := self arrayBody. + self step. + ^array ! ! -!Command methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:37'! -parseOption: aString from: anArray at: anInteger into: aResult - | opt | - opt := self findOption: aString. - opt ifNil: [self error: 'Unknown option: ', aString]. - opt hasValue ifTrue: [ - | val next | - next := anInteger + 1. - next > anArray size ifTrue: [self error: 'Option ', aString, ' requires a value']. - val := anArray at: next. - aResult setOption: opt name to: val. - ^next] - ifFalse: [ - aResult setOption: opt name to: true]. - ^anInteger +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +literalByteArray + | node | + node := self byteArrayBody. + self step. + ^node ! ! -!Command methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:37'! -printUsageOn: aStream - aStream nextPutAll: name. - positionalNames do: [:pname | - aStream nextPutAll: ' <'; nextPutAll: pname; nextPut: $>]. - options do: [:opt | - aStream nextPutAll: ' ['. - opt short ifNotNil: [:s | aStream nextPutAll: s]. - (opt short notNil and: [opt long notNil]) ifTrue: [aStream nextPutAll: '|']. - opt long ifNotNil: [:l | aStream nextPutAll: l]. - opt hasValue ifTrue: [aStream nextPutAll: ' ']. - aStream nextPut: $]] +!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +negativeNumberOrBinary + self peek isNumberNode + ifTrue: [token := self next negate position: token position - 1]. + ^token value ! ! -!Option methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! -beFlag - hasValue := false. - defaultValue := false +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +binaryMessage: aMessageNode + | selector primary argument | + selector := self step. + primary := self primary. + primary isNil ifTrue: [ + ((selector is: $:) and: [token is: #'=']) + ifTrue: [self + error: 'stray whitespaces left in assignment' + at: token position - 1] + ifFalse: [self error: 'primary missing']]. + argument := self unarySequence: primary. + aMessageNode + selector: selector asSelectorNode; + end: argument end; + arguments: {argument} ! ! -!Option methodsFor: 'configuration' stamp: 'KenD 28/Jun/2026 13:27:37'! -beRequired - required := true +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +binarySequence: aParseNode + | node rcvr | + node := aParseNode. + [ + rcvr := node. + self hasBinarySelector] + whileTrue: [ + node := self buildMessageNode: rcvr. + self binaryMessage: node]. + ^node ! ! -!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -defaultValue - ^defaultValue +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +binarySignature + | selector arguments | + ((token isStringToken and: [token hasSymbol]) + or: [token is: $^] + or: [token is: $:]) + ifFalse: [^nil]. + selector := self step asSelectorNode. + token isNameToken ifFalse: [self missingArgument]. + self validateLocalName: token. + arguments := {token asIdentifierNode}. + self step. + token moveCommentsTo: selector. + ^self buildMethodNode: selector arguments: arguments ! ! -!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -defaultValue: anObject - defaultValue := anObject +!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasBinarySelector + ^(token isStringToken and: [token hasSymbol]) + or: [token is: $^] + or: [token is: $:] ! ! -!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -description - ^description +!SSmalltalkParser methodsFor: 'blocks' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +block + | block | + block := self buildNode: compiler blockNode at: token position. + block parent: compiler activeScript. + compiler activate: block while: [ + token moveCommentsTo: block. + self step. + block + arguments: self blockArguments; + temporaries: self temporaries; + addStatements: self statements. + (token is: $]) ifFalse: [self missingToken: ']']. + block end: token position. + token moveCommentsTo: block. + self step]. + ^block ! ! -!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -description: aString - description := aString +!SSmalltalkParser methodsFor: 'blocks' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +blockArguments + | arguments | + (token is: $:) ifFalse: [^#()]. + arguments := OrderedCollection new. + [ + self step. + token isNameToken ifFalse: [self missingArgument]. + self validateLocalName: token. + arguments add: self step asIdentifierNode. + token is: $:] whileTrue. + token isBar ifTrue: [self step] ifFalse: [ + (token is: #'||') + ifTrue: [token value: #'|'] + ifFalse: [self missingToken: '|']]. + ^arguments ! ! -!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -long - ^long +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compiler + ^compiler ! ! -!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -long: aString - long := aString +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler. + scanner := compiler scanner ! ! - -!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -name - long ifNotNil: [^long copyFrom: 3]. - ^short copyFrom: 2 + +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +next + token := next. + next := nil. + ^token ifNil: [token := scanner next] ! ! -!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -short - ^short +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +on: aString + scanner on: aString ! ! -!Option methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -short: aString - short := aString +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +peek + | comments | + next ifNotNil: [^next]. + next := scanner next. + next isComment ifFalse: [^next]. + comments := OrderedCollection new: 2. + [ + comments add: next. + next := scanner next. + next isComment] whileTrue. + ^next comments: comments ! ! -!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! -hasValue - ^hasValue +!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +token + ^token ! ! -!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! -matches: aString - ^aString = short or: [aString = long] +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +error: aString + self error: aString at: token position ! ! -!Option methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! -required - ^required +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +error: aString at: position + ^compiler error: aString at: position ! ! -!Option methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! -initialize - required := false. - hasValue := true. - defaultValue := nil +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +invalidArrayToken + self error: 'invalid literal entry' ! ! -!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -addPositional: aString - positionals add: aString +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +invalidByteValue + self error: 'value not between 0 and 255' ! ! -!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -command - ^command +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +missingArgument + self error: 'argument missing' ! ! -!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -command: aString - command := aString +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +missingExpression + self error: 'missing expression' ! ! -!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -optionAt: aString - ^options at: aString ifAbsent: [nil] +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +missingLiteral + self error: 'missing literal or named literal' ! ! -!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -optionAt: aString ifAbsent: aBlock - ^options at: aString ifAbsent: aBlock +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +missingToken: aString + self error: 'missing ' , aString ! ! -!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -options - ^options +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nonIntegerToken + self error: 'non-integer token' ! ! -!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -positionalAt: anInteger - ^positionals at: anInteger +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +notify: aString + compiler notify: aString at: token position ! ! -!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -positionals - ^positionals +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +notify: aString at: position + compiler notify: aString at: position ! ! -!ParseResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:37'! -setOption: aString to: aValue - options at: aString put: aValue +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +warning: aString + compiler warning: aString at: token position ! ! -!ParseResult methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:37'! -hasOption: aString - ^options includesKey: aString +!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +warning: aString at: position + compiler warning: aString at: position ! ! -!ParseResult methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:37'! -initialize - positionals := OrderedCollection new. - options := OrderedDictionary new +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +headlessMethod + | method | + self step. + method := compiler methodNode. + compiler activeScript: method. + self addBodyTo: method. + ^method ! ! -!MethodSpec methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! -= aMethodSpec - ^aMethodSpec class = self class - and: [aMethodSpec selector == selector] - and: [aMethodSpec classBinding = class] +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +method + | method | + self step. + method := self methodSignature. + method isNil ifTrue: [^nil]. + self addBodyTo: method. + ^method ! ! -!MethodSpec methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:39'! -hash - ^class name hash hashWith: selector +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodFragment + | method | + self step. + method := self methodSignature. + method isNil ifTrue: [^nil]. + [self addBodyTo: method] on: SCompilationError do: []. + ^method ! ! -!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! -asCompiledMethod - self canBeCompiled ifFalse: [^nil]. - ^self - propertyAt: #compiledMethod - ifAbsentPut: [self compiler compileMethod: source] +!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodSelector + self step. + ^self methodSignature ifNotNil: [:m | m selectorNode] ! ! -!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! -ast - self canBeCompiled ifFalse: [^nil]. - ^ast ifNil: [ast := self compiler parseMethod: source] +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parse: aString + ^self on: aString; method ! ! -!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! -cannonicalAst - ^self halt propertyAt: #cannonicalAst ifAbsentPut: [self ast] +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parseExpression: aString + ^self on: aString; headlessMethod ! ! -!MethodSpec methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:39'! -referencedIdentifiers - ^self ast ifNil: [#()] ifNotNil: [:node | node identifiers] +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parseFragment: aString + | method | + self on: aString; step. + [ + method := self methodSignature. + method notNil ifTrue: [self addBodyTo: method]] + on: SCompilationError + do: []. + ^method ! ! -!MethodSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -bytecodes - ^self canBeCompiled ifTrue: [self asCompiledMethod bytecodes] +!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parseTemporaries: aString + self on: aString; step. + ^self methodSignature notNil ifTrue: [self temporaries] ! ! -!MethodSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -classname - ^class name +!SSmalltalkParser methodsFor: 'ffi support' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +symbolicPragma + | position symbol pragma | + position := token position. + symbol := self step value. + pragma := self buildNode: compiler pragmaNode at: position. + ^pragma symbol: symbol ! ! -!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -canBeCompiled - ^self compiler notNil +!SSmalltalkParser class methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parseSelector: aString + | cmp parser | + cmp := SCompiler new. + parser := self new compiler: cmp smalltalkCompiler; on: aString. + ^parser methodSelector ifNotNil: [:n | n value] ! ! -!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -canBeParsed - ^self cannonicalAst notNil +!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildToken: aSmalltalkToken + ^self buildToken: aSmalltalkToken at: stream position ! ! -!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -equals: aMethodSpec - ^self canBeCompiled - and: [aMethodSpec canBeCompiled] - and: [self isFrameless not] - and: [self isEquivalentTo: aMethodSpec] +!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildToken: aSmalltalkToken at: anInteger + | string | + string := stream copyFrom: anInteger to: stream position. + ^self buildToken: aSmalltalkToken at: anInteger with: string ! ! -!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -isEquivalentTo: aMethodSpec - | m1 m2 | - selector == aMethodSpec selector ifFalse: [^false]. - class == aMethodSpec classBinding ifFalse: [^false]. - m1 := self asCompiledMethod. - m1 isNil ifTrue: [^false]. - m2 := aMethodSpec asCompiledMethod. - m2 isNil ifTrue: [^false]. - ^m1 equals: m2 +!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildToken: aSmalltalkToken at: anInteger with: anObject + ^aSmalltalkToken + position: anInteger; + value: anObject; + end: stream position ! ! -!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -isExtension - ^class isExtension +!SSmalltalkScanner methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +canBeInIdentifier: aCharacter + ^compiler frontend canBeInIdentifier: aCharacter ! ! -!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -isFrameless - ^self halt asCompiledMethod isFrameless +!SSmalltalkScanner methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +canStartIdentifier: aCharacter + (compiler frontend canStartIdentifier: aCharacter) ifFalse: [^false]. + aCharacter = $_ + ifTrue: [^stream peek ifNil: [false] ifNotNil: [:ch | ch asInteger >= 33]]. + ^true ! ! -!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -referencesIdentifier: aString - ^self referencedIdentifiers - anySatisfy: [:identifier | identifier name = aString] +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compiler + ^compiler ! ! -!MethodSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -usesInstanceVariableNamed: aString - ^(self ast variableNamed: aString) notNil +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler. + compiler sourceCode ifNotNil: [:s | self sourceCode: s] ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -category - ^self isExtension - ifTrue: ['*' , (module name readStream upToLast: $-)] - ifFalse: [category] +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +on: aString + stream := aString readStream. + compiler notNil ifTrue: [compiler sourceCode: aString] ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -category: aString - category := aString +!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sourceCode: aString + stream := aString readStream ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -classBinding - ^class +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +end + ^self buildToken: compiler endToken at: stream position + 1 ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -classBinding: aSpeciesSpec - class := aSpeciesSpec +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isBinary: aCharacter + | code | + aCharacter isNil ifTrue: [^false]. + code := aCharacter asInteger. + code < 128 ifTrue: [ + ^#($+ $- $< $> $= $* $/ $\ $| $& $~ $, $@ $% $? $!! $: $^) + includes: aCharacter]. + ^code > 255 ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -module - ^module +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +next + ^self nextToken ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -module: aModuleSpec - module := aModuleSpec +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextArrayPrefix + | string | + string := stream copyFrom: stream position - 1 to: stream position. + ^self + buildToken: compiler delimiterToken + at: stream position - 1 + with: string ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeFromClass - class removeMethod: self +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextAssignment + ^self buildToken: compiler delimiterToken at: stream position with: #':=' ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -selector - ^selector +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextBinarySelector + stream back. + ^self + buildToken: compiler stringToken + at: stream position + 1 + with: self scanBinarySymbol ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -selector: aSymbol - selector := aSymbol +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextBinarySymbol + ^self + buildToken: compiler literalNode + at: stream position + with: self scanBinarySymbol ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -source - ^source -! ! +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextColon + | start char | + start := stream position. + char := stream peek. + ((char = Character space or: [char = Character tab]) and: [(stream peek: 2) second = $=]) ifTrue: [ + stream skip: 1. + char := $=]. + char = $= ifTrue: [ + stream skip. + ^self nextAssignment position: start]. + ^(self isBinary: stream peek) + ifTrue: [self nextBinarySelector] + ifFalse: [self nextSpecialCharacter] -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -source: aString - source := aString. - ast := nil ! ! -!MethodSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -sourceCode - ^source -! ! +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextComment + | start comment | + start := stream position. + [ stream atEnd not and:[stream peek !!== $"] ] whileTrue: [stream next]. + stream atEnd ifTrue: [self error: 'unfinished comment' at: start]. + stream position: start. + comment := stream upTo: $". + ^self buildToken: compiler commentNode at: start with: comment -!MethodSpec methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! -printOn: aStream - aStream nextPutAll: class name asString , '>>#' , selector asString ! ! -!MethodSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! -resolveClass - ^module resolveClass: class name +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextIdentifierOrKeyword + | start | + start := stream position. + self skipIdentifier. + ((stream peekFor: $:) and: [stream peekFor: $=]) ifTrue: [stream skip: -2]. + ^self buildToken: compiler stringToken at: start ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -addClass: aClassSpec - classes add: aClassSpec +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextKeyword + | start string | + start := stream position + 1. + self skipKeyword. + string := stream copyFrom: start to: stream position. + ^self buildToken: compiler literalNode at: start - 1 with: string asSymbol ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -addClassExtension: aClassSpec - extendedClasses add: aClassSpec +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextLiteralCharacter + stream atEnd ifTrue: [^self error: 'character expected']. + ^self + buildToken: compiler literalNode + at: stream position + with: stream next ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -addClasses: aCollection - aCollection do: [:c | self addClass: c] +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextLiteralString + ^self + buildToken: compiler literalNode + at: stream position + with: self scanString reduced ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -addDependencies: aCollection - aCollection keysAndValuesDo: [:dep :objects | - dependencies - at: dep - put: objects - ifPresent: [:current | (current addAll: objects) withoutDuplicates]] +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextNumber + | parser assoc | + stream skip: -1. + parser := NumberParser new on: stream. + assoc := parser next. + parser error ifNotNil: [:e | ^self error: e key at: e value]. + ^self + buildToken: compiler numericLiteralNode + at: assoc value start + with: assoc key ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -addSubclassifiedClass: aClassSpec - subclassifiedClasses addIfAbsent: aClassSpec +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextQuotedSymbol + | node | + node := self nextLiteralString. + ^node beSymbol; position: node position - 1 ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -associationAt: aSymbol ifAbsent: aBlock - ^imports associationAt: aSymbol ifAbsent: aBlock +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextSpecialCharacter + | token | + token := self buildToken: compiler delimiterToken. + ^token beCharacter ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -cleanDependencies - | needed | - needed := OrderedCollection new. - self methodReferences keys do: [:identifier | needed add: identifier name]. - self hierarchyReferences keys - do: [:identifier | needed add: identifier name]. - extendedClasses do: [:c | needed add: c name]. - dependencies copy keysAndValuesDo: [:module :identifiers | - (identifiers keys anySatisfy: [:identifier | needed includes: identifier]) - ifFalse: [dependencies removeKey: module]] +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextSymbolOrArrayPrefix + | char | + stream atEnd ifTrue: [self error: 'character expected']. + char := stream peek. + (self canBeInIdentifier: char) ifTrue: [^self nextKeyword]. + (self isBinary: char) ifTrue: [^self nextBinarySymbol]. + stream next. + (char = $[ or: [char = $(]) ifTrue: [^self nextArrayPrefix]. + char = $' ifTrue: [^self nextQuotedSymbol]. + self error: 'character expected' ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -hierarchyReferences - | references | - references := Dictionary new. - self allClassesDo: [:c | | list | - c superclass ifNotNil: [ - list := references at: c superclass ifAbsentPut: [OrderedCollection new]. - list add: c]]. - ^references +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nextToken + | first | + first := self scanChar. + first isNil ifTrue: [^self end]. + (self canStartIdentifier: first) ifTrue: [^self nextIdentifierOrKeyword]. + (first = $→ or: [first = $_]) ifTrue: [^self nextAssignment]. + first = $: ifTrue: [^self nextColon]. + first = $' ifTrue: [^self nextLiteralString]. + first = $$ ifTrue: [^self nextLiteralCharacter]. + first = $# ifTrue: [^self nextSymbolOrArrayPrefix]. + first = $" ifTrue: [^self nextComment]. + first isDigit ifTrue: [^self nextNumber]. + (first !!= $^ and: [first !!= $↑ and: [self isBinary: first]]) + ifTrue: [^self nextBinarySelector]. + ^self nextSpecialCharacter ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -methodReferences - | references | - references := Dictionary new. - self allMethodsDo: [:m | - m referencedIdentifiers reject: #isLocal thenDo: [:identifier | | list | - list := references at: identifier ifAbsentPut: [OrderedCollection new]. - list add: m]]. - ^references +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +scanBinarySymbol + | start symbol | + start := stream position. + self skipBinary. + symbol := stream copyFrom: start + 1 to: stream position. + ^symbol asSymbol ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -printOn: aStream - aStream - nextPut: $<; - print: name; - nextPutAll: '> module' -! ! +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +scanChar + ^(stream skipSeparators; atEnd) ifFalse: [stream next] -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeCategory: aSymbol inClass: aClassSpec - | class | - class := self resolveClass: aClassSpec. - class removeCategory: aSymbol ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeClass: aClassSpec - | class | - class := self resolveClass: aClassSpec. - classes remove: class ifAbsent: nil +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +scanString + | current start | + start := current := stream position. + ^String streamContents: [:writer | + [| fragment | + fragment := stream upTo: $'. + writer nextPutAll: fragment. + (current < stream position and: [(stream back; next) = $']) + ifFalse: [self error: 'string end expected' at: start]. + stream peekFor: $'] + whileTrue: [ + writer nextPut: $'. + current := stream position]] ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeEmptyExtensions - extendedClasses copy - reject: #hasMethods - thenDo: [:c | extendedClasses remove: c] +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +skipBinary + [self isBinary: stream peek] whileTrue: [stream next] ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeExtendedClass: aClassSpec - | class | - class := self resolveClass: aClassSpec. - extendedClasses remove: class ifAbsent: nil +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +skipIdentifier + | frontend | + frontend := compiler frontend. + [stream atEnd] + whileFalse: [(frontend peekForIdentifier: stream) ifFalse: [^self]] ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeMethod: aMethodSpec - self ASSERT: (self includesClass: aMethodSpec classBinding). - aMethodSpec classBinding removeMethod: aMethodSpec +!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +skipKeyword + | frontend continue pos | + frontend := compiler frontend. + [ + self skipIdentifier. + continue := false. + (stream peekFor: $:) ifTrue: [ + pos := stream position. + stream atEnd + ifFalse: [continue := frontend canStartIdentifier: stream peek]]. + continue] whileTrue. + pos isNil ifFalse: [stream position: pos] ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeSelectors: aCollection - self allClassesDo: [:c | - c removeSelectors: aCollection. - c metaclass removeSelectors: aCollection] +!SSmalltalkScanner methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +error: aString + ^self error: aString at: stream position ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeSelectors: aCollection inClass: aClassSpec - | class | - class := self resolveClass: aClassSpec. - class removeSelectors: aCollection +!SSmalltalkScanner methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +error: aString at: anInteger + ^compiler error: aString at: anInteger ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeSelectors: aCollection inScope: aClassSpec - | class all | - class := self resolveClass: aClassSpec. - all := self withAllSubclasses: class. - all do: [:c | c removeSelectors: aCollection] +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +comment + ^comments notNil ifTrue: [comments anyOne] ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeSubclassesOf: aClassSpec - | class | - class := self resolveClass: aClassSpec. - class allSubclasses do: [:c | self removeClass: c; removeExtendedClass: c] +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +comments + ^comments ! ! -!ModuleSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeSubclassifiedClass: aClassSpec - | class | - class := self resolveClass: aClassSpec. - subclassifiedClasses remove: class ifAbsent: nil +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +comments: aCollection + aCollection isNil ifTrue: [^self]. + comments isNil + ifTrue: [comments := aCollection] + ifFalse: [comments addAll: aCollection] ! ! -!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! -addImport: anAssociation - imports add: anAssociation +!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +moveCommentsTo: aParseNode + aParseNode comments: comments. + comments := nil ! ! -!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! -addImports: aCollection - aCollection do: [:token | self addImport: token asSymbol -> nil] +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compileWarning: aString + compiler notify: aString at: self stretch ! ! -!ModuleSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! -initialize - classes := OrderedCollection new. - extendedClasses := OrderedCollection new. - subclassifiedClasses := OrderedCollection new. - imports := Dictionary new. - dependencies := Dictionary new +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compiler + ^compiler ! ! -!ModuleSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -allClasses - ^classes , extendedClasses +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +compiler: aSmalltalkCompiler + compiler := aSmalltalkCompiler ! ! -!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! -allClassesDo: aBlock - classes do: aBlock. - extendedClasses do: aBlock +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +end + ^stretch end ! ! -!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! -allMethods - | methods | - methods := OrderedCollection new. - self allMethodsDo: [:m | methods add: m]. - ^methods +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +end: aNumber + stretch end: aNumber ! ! -!ModuleSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! -allMethodsDo: aBlock - self allClassesDo: [:c | - c metaclass methods do: aBlock. - c methods do: aBlock] +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +position + ^stretch start ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -at: aSymbol - ^self at: aSymbol ifAbsent: nil +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +position: aNumber + stretch start: aNumber ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -at: aSymbol ifAbsent: aBlock - | string | - string := aSymbol asString. - classes do: [:c | c name = string ifTrue: [^c]]. - extendedClasses do: [:c | c name = string ifTrue: [^c]]. - subclassifiedClasses do: [:c | c name = string ifTrue: [^c]]. - ^imports at: aSymbol ifAbsent: aBlock +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +prevPosition + ^stretch start - 1 ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -classes - ^classes +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +source + ^compiler sourceCode copyFrom: stretch start to: stretch end ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -dependencies - ^dependencies +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +stretch + ^stretch ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -dependencies: aDictionary - dependencies := aDictionary +!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +stretch: aStretch + stretch := aStretch ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -description - ^description +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +endsExpression + ^self isEnd ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -description: aString - description := aString +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasSymbol + ^false ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -extendedClasses - ^extendedClasses +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +is: anObject + ^false ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -name - ^name +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isAssignment + ^false ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -name: aString - name := aString +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isBar + ^(self is: #'|') or: [self is: #'/'] ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -referencedGlobals - | referenced | - referenced := Dictionary new. - self allMethodsDo: [:m | - m referencedIdentifiers - select: [:identifier | | b | - b := identifier binding. - b refersToGlobal or: [b isUnresolved]] - thenDo: [:global | (referenced - at: global name - ifAbsentPut: [OrderedCollection new]) - add: m]]. - ^referenced +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isBlockNode + ^false ! ! -!ModuleSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -requiredImports - | required | - required := Dictionary new. - self referencedGlobals - keysAndValuesDo: [:global :dependents | (self definesGlobal: global) - ifFalse: [required at: global put: dependents]]. - ^required +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isComment + ^false ! ! -!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:27:39'! -basicResolveClass: aString - classes do: [:c | c name asString = aString ifTrue: [^c]]. - extendedClasses do: [:c | c name asString = aString ifTrue: [^c]]. - subclassifiedClasses do: [:c | c name asString = aString ifTrue: [^c]]. - ^nil +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isDelimiter + ^false ! ! -!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:27:39'! -definesGlobal: aString - ^classes anySatisfy: [:c | c name = aString] +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isEnd + ^false ! ! -!ModuleSpec methodsFor: 'resolving' stamp: 'KenD 28/Jun/2026 13:27:39'! -resolveClass: class - | moniker metaclass found | - moniker := class isString ifTrue: [class] ifFalse: [class name]. - metaclass := moniker endsWith: ' class'. - metaclass ifTrue: [moniker := moniker trimTail: ' class']. - found := self basicResolveClass: moniker. - ^found ifNotNil: [metaclass ifTrue: [found metaclass] ifFalse: [found]] +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isIdentifier + ^false ! ! -!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -definesClassNamed: aString - ^classes anySatisfy: [:c | c name = aString] +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isKeyword + ^false ! ! -!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -extendsClassNamed: aString - ^extendedClasses anySatisfy: [:c | c name = aString] +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isLiteral + ^false ! ! -!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -includesClass: aClassSpec - ^(self resolveClass: aClassSpec) notNil +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isNameToken + ^false ! ! -!ModuleSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -subclassifiesClassNamed: aString - ^subclassifiedClasses anySatisfy: [:c | c name = aString] +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isNumberNode + ^false ! ! -!ModuleSpec methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:39'! -sortedClasses - | remaining sorted | - remaining := classes copy. - sorted := OrderedCollection new. - [remaining isEmpty] whileFalse: [| c | - c := remaining first. - (remaining includes: c superclass) - ifTrue: [remaining removeFirst; add: c] - ifFalse: [ - remaining remove: c. - sorted add: c]]. - ^sorted +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isPoolLiteral + ^false ! ! -!ModuleSpec methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:39'! -withAllSubclasses: aClassSpec - | all | - all := self allClasses. - aClassSpec isMetaclass ifTrue: [all := all collect: #metaclass]. - ^all select: [:c | c withAllSuperclasses includes: aClassSpec] +!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isStringToken + ^false ! ! -!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -addMethod: aMethodSpec - ^methods add: aMethodSpec +!SToken methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + stretch := 1 thru: 0 ! ! -!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -addMethods: aCollection - aCollection do: [:m | self addMethod: m] +!SToken methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isDelimitedIdentifier + ^false ! ! -!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeCategory: aSymbol - methods removeAllSuchThat: [:m | m category == aSymbol] +!SEndToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isEnd + ^true ! ! -!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeMethod: aMethodSpec - methods remove: aMethodSpec ifAbsent: nil +!SEndToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +position: aNumber + super position: aNumber - 1 ! ! -!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeSelector: aSymbol - methods removeAllSuchThat: [:m | m selector == aSymbol] +!SEndToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +prevPosition + ^stretch start ! ! -!SpeciesSpec methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:39'! -removeSelectors: aCollection - methods removeAllSuchThat: [:m | aCollection includes: m selector] +!SEndToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +value: aString + '' ! ! -!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -allInstVarNames - ^(self withAllSuperclasses reversed gather: [:c | c instVarNames]) asArray +!SParseNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitParseNode: self ! ! -!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -allSharedPools - | pools | - pools := Set new. - self withAllSuperclasses do: [:c | pools addAll: c sharedPools]. - ^pools +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +allNodesDo: aBlock + self nodesDo: aBlock includingDeclarations: true ! ! -!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -allSuperclasses - | superclasses | - superclasses := OrderedCollection new. - self allSuperclassesDo: [:s | superclasses add: s]. - ^superclasses -! ! +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +nodeWithLiteral: anObject + ^self nodesDetect: [:n | (n isLiteral or: [n isSelector]) and: [n value = anObject]] ifAbsent: nil -!SpeciesSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -withAllSuperclasses - ^OrderedCollection with: self withAll: self allSuperclasses ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -allSubclasses - | all | - all := OrderedCollection new. - self allSubclassesDo: [:cls | all add: cls]. - ^all +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +nodesDetect: aBlock ifAbsent: absentBlock + self nodesDo: [:node | (aBlock value: node) ifTrue: [ ^node ] ] includingDeclarations: false. + ^absentBlock value ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -allSubclassesDo: aBlock - self subclasses do: [:class | - aBlock value: class. - class allSubclassesDo: aBlock] +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +nodesDo: aBlock + self nodesDo: aBlock includingDeclarations: false ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -beArrayed - format := format | IsArrayed +!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +nodesDo: aBlock includingDeclarations: aBoolean + aBlock value: self ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -beBytes - format := format | IsBytes +!SParseNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +ast + ^compiler ast ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -instVarNames - ^instanceVariables +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +hasAssign + ^false ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -instVarNames: aCollection - instanceVariables := aCollection asOrderedCollection +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isAssign + ^false ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -ivars: aCollection - instanceVariables := aCollection asOrderedCollection +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isBraceNode + ^false ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -methods - ^methods +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isCascade + ^false ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -module: aModuleSpec - module := aModuleSpec +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isCascadeMessage + ^false ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -selectors - ^methods collect: #selector +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isEvaluable + ^false ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -subclasses - ^module allClasses select: [:c | c supername = self name] +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isImmediate + ^false ! ! -!SpeciesSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -withAllSubclasses - ^OrderedCollection with: self withAll: self allSubclasses +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isMessageNode + ^false ! ! -!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -hasMethods - ^methods notEmpty +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isMethod + ^false ! ! -!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -instancesAreArrayed - ^format anyMask: IsArrayed +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isMethodArgument + ^false ! ! -!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -instancesHavePointers - ^(format anyMask: IsBytes) not +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isMethodTemporary + ^false ! ! -!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -isExtension - ^module extendedClasses includes: self instanceClass +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isReturn + ^false ! ! -!SpeciesSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -isMetaclass +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isSelector ^false ! ! -!SpeciesSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! -initialize - super initialize. - methods := OrderedCollection new. - instanceVariables := #(). - format := 0 +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isSelf + ^false ! ! -!SpeciesSpec methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:39'! -printOn: aStream - aStream nextPutAll: '<' , self name , '>' +!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isSuper + ^false ! ! -!SpeciesSpec class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! -initializeFormatMasks - self addNamespaceAs: #Format. - Format - at: 'IsArrayed' put: 0x1; - at: 'IsBytes' put: 0x2 +!SParseNode methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +moveCommentsFrom: aParseNode + aParseNode moveCommentsTo: self ! ! -!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -allMethods - ^methods & metaclass methods +!SParseNode methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +variableNamed: aString + self + allNodesDo: [:node | (node isIdentifier and: [node name = aString]) + ifTrue: [^node]]. + ^nil ! ! -!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -classVarNames - ^classVariables keys +!SAssignmentNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitAssignment: self ! ! -!ClassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -metaMethods - ^metaclass methods +!SAssignmentNode methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assign: anIdentifierNode operator: aDelimiterToken + assignees add: anIdentifierNode. + operators add: aDelimiterToken ! ! -!ClassSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! -allSuperclassesDo: aBlock - | s | - supername isNil ifTrue: [^self]. - s := self superclass. - s isNil ifTrue: [^self]. - aBlock value: s. - s allSuperclassesDo: aBlock +!SAssignmentNode methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assign: anIdentifierNode with: aParseNode operator: aDelimiterToken + assignees add: anIdentifierNode. + operators add: aDelimiterToken. + expression := aParseNode ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -classVariables - ^classVariables +!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assignees + ^assignees ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -configureCompiler: aCompiler - +!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +expression + ^expression ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -cvarNames: aCollection - aCollection do: [:cvar | classVariables at: cvar put: nil] +!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +operators + ^operators ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -cvars: aCollection - classVariables := aCollection +!SAssignmentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasAssign + ^true ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -instanceClass - ^self +!SAssignmentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isAssign + ^true ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -isPointers - ^pointers +!SAssignmentNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + assignees := OrderedCollection new: 1. + operators := OrderedCollection new: 1 ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -isPointers: aBoolean - pointers := aBoolean +!SAssignmentNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + assignees do: [:v | v nodesDo: aBlock includingDeclarations: aBoolean]. + expression nodesDo: aBlock includingDeclarations: aBoolean ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -isVariable - ^variable +!SBraceNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitBraceNode: self ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -isVariable: aBoolean - variable := aBoolean +!SBraceNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +asMessageNode + message notNil ifTrue: [^message]. + ^message := self expanded ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -metaclass - ^metaclass +!SBraceNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isBraceNode + ^true ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -metaclass: aMetaclassSpec - metaclass := aMetaclassSpec +!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +elements + ^elements ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -name - ^name +!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +elements: aCollection + elements := aCollection asArray ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -name: aString - name := aString +!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +expanded + | receiver n new argument array messages i you yourself cascade | + receiver := compiler identifierNode name: 'Array'. + n := elements size. + new := compiler selectorNode symbol: #new:. + argument := compiler numericLiteralNode value: n. + array := compiler messageNode. + array receiver: receiver. + array selector: new. + array arguments: (Array with: argument). + i := 0. + messages := elements collect: [:elem | | msg sel idx args | + i := i + 1. + msg := compiler cascadeMessageNode position: elem position; end: elem end. + sel := compiler selectorNode symbol: #at:put:. + idx := compiler numericLiteralNode value: i. + args := Array with: idx with: elem. + msg selector: sel; arguments: args]. + you := compiler selectorNode symbol: #yourself. + yourself := compiler cascadeMessageNode. + yourself selector: you. + yourself arguments: #(). + messages := messages copyWith: yourself. + cascade := compiler cascadeNode receiver: array. + messages do: [:msg | msg cascade: cascade]. + ^cascade messages: messages ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -sharedPools - ^sharedPools +!SBraceNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + elements do: [:n | n nodesDo: aBlock includingDeclarations: aBoolean] ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -sharedPools: aCollection - sharedPools addAll: aCollection +!SCascadeNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitCascade: self ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -superclass - supername ifNil: [^nil]. - ^module resolveClass: supername +!SCascadeNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasAssign + receiver hasAssign ifTrue: [^true]. + messages detect: [:msg | msg hasAssign] ifNone: [^false]. + ^true ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -supername - ^supername +!SCascadeNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isCascade + ^true ! ! -!ClassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -supername: aString - supername := aString +!SCascadeNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + receiver nodesDo: aBlock includingDeclarations: aBoolean. + messages do: [:msg | msg nodesDo: aBlock includingDeclarations: aBoolean] ! ! -!ClassSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -hasMethods - ^super hasMethods or: [metaclass hasMethods] +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +messages + ^messages ! ! -!ClassSpec methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:39'! -initialize - super initialize. - classVariables := OrderedDictionary new. - sharedPools := OrderedCollection new +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +messages: aCollection + messages := aCollection ! ! -!MetaclassSpec methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:39'! -allSuperclassesDo: aBlock - | s c | - class supername isNil ifTrue: [ - c := module resolveClass: 'Class'. - c ifNil: [c := Class]. - c allSuperclassesDo: aBlock]. - s := self superclass. - s isNil ifTrue: [^self]. - aBlock value: s. - s allSuperclassesDo: aBlock +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +receiver + ^receiver ! ! -!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -classVarNames - ^class classVarNames +!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +receiver: rcvr + receiver := rcvr ! ! -!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -metaMethods - ^#() +!SCommentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isComment + ^true ! ! -!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -name - ^class name , ' class' +!SCommentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +value + ^value ! ! -!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -sharedPools - ^class sharedPools +!SCommentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +value: aString + value := aString ! ! -!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -superclass - ^class superclass ifNotNil: [:c | c metaclass] +!SIdentifierNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitIdentifier: self ! ! -!MetaclassSpec methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:39'! -supername - ^self superclass name +!SIdentifierNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beAssigned + | immutable | + binding canBeAssigned ifTrue: [^self]. + immutable := binding isClassBinding + ifTrue: ['class'] + ifFalse: [compiler activeScope describe: binding name]. + self compileError: 'cannot assign to ' , immutable ! ! -!MetaclassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -instanceClass - ^class +!SIdentifierNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +resolveAssigning: aBoolean + binding := compiler activeScope resolve: name. + ^binding + ! ! -!MetaclassSpec methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:39'! -instanceClass: aClassSpec - class := aClassSpec +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +binding + ^binding ! ! -!MetaclassSpec methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:39'! -isMetaclass - ^true +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +binding: aBinding + binding := aBinding ! ! -!IdentifierBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -contents - ^contents +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + binding := DynamicBinding default ! ! -!IdentifierBinder methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -keyFor: aString - ^self subclassResponsibility +!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name + ^name ! ! -!IdentifierBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! -printOn: aStream - self printOn: aStream indent: 0 +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +checkLowercase + | char | + char := name first. + (char isLetter and: [char isUppercase]) ifFalse: [^self]. + self compileWarning: name storeString , ' should start with lowercase' ! ! -!IdentifierBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! -printOn: aStream indent: anInteger - self subclassResponsibility +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isEvaluable + ^self isIdentifierLiteral ! ! -!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -at: aString - ^contents at: aString ifAbsent: nil +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isIdentifier + ^true ! ! -!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -at: aString ifAbsentPut: aBlock - ^contents at: aString ifAbsentPut: aBlock +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isIdentifierLiteral + binding isDynamic ifFalse: [^binding isLiteral]. + ^self ast ifNil: [false] ifNotNil: [:ast | | b | + b := ast scope resolve: name. + b isLiteral] ! ! -!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -at: aString put: aBinding - contents at: aString put: aBinding +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isImmediate + ^true ! ! -!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -define: aString as: aBinding - contents at: aString put: aBinding +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isLocal + ^binding isLocal ! ! -!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -defines: identifier - ^contents includesKey: identifier +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isMethodArgument + | ast | + binding isArgument ifFalse: [^false]. + ast := self ast ifNil: [^false]. + ^ast arguments includes: self declaration ! ! -!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -do: aBlock - contents do: aBlock +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isMethodTemporary + ^self ast temporaries includes: self declaration ! ! -!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -select: aBlock - ^contents select: aBlock +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isSelf + ^binding isSelf ! ! -!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -values - ^contents values +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isSuper + ^binding isSuper ! ! -!StaticBinder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -withIndexDo: aBlock - contents withIndexDo: aBlock +!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sourceIntervals + | stretchs declaration ast string code index | + stretchs := OrderedCollection new. + declaration := binding declaration. + ast := self ast. + ast allNodesDo: [:node | + (node class == self class and: [node binding declaration == declaration]) + ifTrue: [stretchs add: node stretch]]. + string := self source. + code := compiler sourceCode. + index := ast stretch end. + [ + index := code indexOfString: string startingAt: index + 1. + index > 0] + whileTrue: [stretchs add: (index to: index + string size - 1)]. + ^stretchs ! ! -!StaticBinder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - contents := OrderedDictionary new +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +declaration + ^binding declaration ! ! -!StaticBinder methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! -printOn: aStream indent: anInteger - aStream tab: anInteger; nextPut: $<. - contents keys - do: [:name | name printOn: aStream] - separatedBy: [aStream space]. - aStream nextPut: $> +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +defineArgumentIn: aScriptScope + binding := aScriptScope defineArgument: name. + binding declaration: self ! ! -!LocalEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isInlinedArgument - ^false +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +defineTemporaryIn: scope + binding := scope defineTemporary: name. + binding declaration: self ! ! -!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureType - ^CaptureEnvironmentValue +!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +printOn: aStream + aStream nextPut: $<; + nextPutAll: name; + nextPutAll: '> ('. + super printOn: aStream. + aStream nextPut: $) ! ! -!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -index - ^index +!SIdentifierNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name: aString + name := aString reduced ! ! -!ArrayEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -index: anInteger - index := anInteger +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitLiteral: self ! ! -!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isCurrent - ^index isNil +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +hasSymbol + ^value isSymbol ! ! -!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isIndirect - ^self isCurrent not +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isEvaluable + ^true ! ! -!ArrayEnvironment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isStack - ^false +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isImmediate + ^true ! ! -!StackEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -index - ^nil +!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isLiteral + ^true ! ! -!StackEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -isStack - ^true +!SLiteralNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +beSymbol + value := value asSymbol ! ! -!ArgumentEnvironment methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureType - ^CaptureLocalArgument +!SLiteralNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +value + ^value ! ! -!InlinedArgEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -captureType - ^CaptureInlinedArgument +!SLiteralNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +value: anObject + value := anObject ! ! -!InlinedArgEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isInlinedArgument - ^true +!SNumberNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitNumberNode: self ! ! -!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026 13:27:40'! -inline: aMessageNode - | s keywords | - message := aMessageNode. - message receiver isSuper - ifTrue: [ ^ self ]. - message isCascadeMessage - ifTrue: [ ^ self ]. - s := message selector value. - s == #ifTrue: - ifTrue: [ ^ self inlineConditional ]. - s == #ifFalse: - ifTrue: [ ^ self inlineConditional ]. - s == #or: - ifTrue: [ ^ self inlineConditional ]. - s == #and: - ifTrue: [ ^ self inlineConditional ]. - s == #timesRepeat: - ifTrue: [ ^ self inlineConditional ]. - s == #ifTrue:ifFalse: - ifTrue: [ ^ self inlineConditional ]. - s == #ifFalse:ifTrue: - ifTrue: [ ^ self inlineConditional ]. - s == #andNot: - ifTrue: [ ^ self inlineConditional ]. - s == #orNot: - ifTrue: [ ^ self inlineConditional ]. - s == #ifNil: - ifTrue: [ ^ self inlineConditional ]. - s == #ifNotNil: - ifTrue: [ ^ self inlineIfNotNil ]. - s == #ifNil:ifNotNil: - ifTrue: [ ^ self inlineIfNilIfNotNil ]. - s == #ifNotNil:ifNil: - ifTrue: [ ^ self inlineIfNotNilIfNil ]. - s == #whileTrue: - ifTrue: [ ^ self inlineWhile ]. - s == #whileFalse: - ifTrue: [ ^ self inlineWhile ]. - s == #whileTrue - ifTrue: [ ^ self inlineUnitaryWhile ]. - s == #whileFalse - ifTrue: [ ^ self inlineUnitaryWhile ]. - s == #repeat - ifTrue: [ ^ self inlineRepeat ]. - s == #to:do: - ifTrue: [ ^ self inlineToDo ]. - "s == #to:by:do: - ifTrue: [ ^ self inlineToByDo ]." - keywords := $: split: s. - keywords last = '' - ifTrue: [ keywords := keywords allButLast ]. - (keywords conform: [ :k | k = 'and' ]) - ifTrue: [ ^ self inlineConditional ]. - (keywords conform: [ :k | k = 'or' ]) - ifTrue: [ ^ self inlineConditional ]. - ((keywords allButLast conform: [ :k | k = 'and' ]) - and: [ #('ifTrue' 'ifFalse') includes: keywords last ]) - ifTrue: [ ^ self inlineConditional ]. - ((keywords allButLast conform: [ :k | k = 'or' ]) - and: [ #('ifTrue' 'ifFalse') includes: keywords last ]) - ifTrue: [ self inlineConditional ] +!SNumberNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isNumberNode + ^true ! ! -!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026 13:27:40'! -inlineRepeat - | receiver arguments | - receiver := message receiver. - receiver isEvaluable - ifFalse: [ ^ self ]. - arguments := message arguments. - arguments isEmpty - ifFalse: [ ^ self ]. - receiver isBlockNode - ifFalse: [ ^ self ]. - message beInlined. - receiver beInlined +!SNumberNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +negate + value := value negated ! ! -!MessageInliner methodsFor: 'transforming' stamp: 'KenD 28/Jun/2026 13:27:40'! -inlineUnitaryWhile - | receiver arguments | - receiver := message receiver. - receiver isEvaluable ifFalse: [^self]. - arguments := message arguments. - arguments size = 0 ifFalse: [^self]. - self inlineConditional. - receiver isBlockNode ifTrue: [ - message beInlined. - receiver beInlined] +!SMessageNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitMessage: self ! ! -!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! -inlineConditional - | arguments | - arguments := message arguments. - arguments size >= 1 ifFalse: [^self]. - arguments do: [:arg | arg isEvaluable ifFalse: [^self]]. - message beInlined. - arguments select: #isBlockNode thenDo: #beInlined +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +arguments + ^arguments ! ! -!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! -inlineIfNilIfNotNil - | arguments arg | - arguments := message arguments. - arguments size = 2 ifFalse: [^self]. - arguments first isEvaluable ifFalse: [^self]. - arg := arguments second. - (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) - ifFalse: [^self]. - message beInlined. - arguments select: #isBlockNode thenDo: #beInlined - +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +arguments: aCollection + arguments := aCollection ! ! -!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! -inlineIfNotNil - | arguments arg | - arguments := message arguments. - arguments size = 1 ifFalse: [^self]. - arg := arguments first. - (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) - ifFalse: [^self]. - message beInlined. - arg isBlockNode ifTrue: [arg beInlined] +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +receiver + ^receiver ! ! -!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! -inlineIfNotNilIfNil - | arguments arg | - arguments := message arguments. - arguments size = 2 ifFalse: [^self]. - arguments second isEvaluable ifFalse: [^self]. - arg := arguments first. - (arg isEvaluable or: [arg isBlockNode and: [arg arguments size = 1]]) - ifFalse: [^self]. - message beInlined. - arguments select: #isBlockNode thenDo: #beInlined +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +receiver: node + receiver := node ! ! -!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! -inlineToByDo - | arguments arg step | - arguments := message arguments. - arguments size = 3 ifFalse: [^self]. - arg := arguments at: 3. - arg isBlockNode ifFalse: [^self]. - arg arguments size = 1 ifFalse: [^self]. - step := arguments at: 2. - (step isNumberNode and: [step value isSmallInteger]) ifFalse: [^self]. - message beInlined. - arg beInlined +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +selector + ^selector ! ! -!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! -inlineToDo - | arguments last | - arguments := message arguments. - arguments size = 2 ifFalse: [^self]. - last := arguments at: 2. - last isBlockNode ifFalse: [^self]. - last arguments size = 1 ifFalse: [^self]. - message beInlined. - last beInlined +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +selector: node + selector := node ! ! -!MessageInliner methodsFor: 'inlining' stamp: 'KenD 28/Jun/2026 13:27:40'! -inlineWhile - | receiver arguments | - receiver := message receiver. - receiver isEvaluable - ifFalse: [ ^ self ]. - arguments := message arguments. - arguments size = 1 - ifFalse: [ ^ self ]. - arguments last isNullary - ifFalse: [ ^ self ]. - self inlineConditional. - receiver isBlockNode - ifTrue: [ receiver beInlined ] +!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +symbol + ^selector symbol ! ! -!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -ast - ^ast +!SMessageNode methodsFor: 'emitting - inlined' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beInlined + inlined := true ! ! -!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -ast: aParseNode - ast := aParseNode +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasAssign + receiver hasAssign ifTrue: [^true]. + ^arguments anySatisfy: [:arg | arg hasAssign] ! ! -!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -compiler: aSmalltalkCompiler - compiler := aSmalltalkCompiler +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasVolatileArguments + ^arguments anySatisfy: [:arg | + arg isIdentifier + ifTrue: [arg binding canBeAssigned] + ifFalse: [arg isBlockNode not andNot: [arg isLiteral]]] ! ! -!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -method - ^method +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasVolatileReceiver + ^ compiler hasBlocks + or: [ receiver isMethodTemporary not ] + or: [ arguments anySatisfy: [ :arg | arg hasAssign ] ] ! ! -!SCompilationResult methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -method: aCompiledMethod - method := aCompiledMethod +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + inlined := false ! ! -!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -beSuccessful - error := nil +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isCascadeMessage + ^false ! ! -!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -error - ^error +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isInlined + ^inlined ! ! -!SCompilationResult methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -error: aCompilationError - error := aCompilationError +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isMessageNode + ^true ! ! -!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -canBeInIdentifier: aCharacter - ^aCharacter isLetter or: [aCharacter isDigit] or: [aCharacter = $_] +!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +needsStrictEvaluationOrder + arguments size = 0 ifTrue: [^false]. + receiver isBlockNode ifTrue: [^false]. + receiver isLiteral ifTrue: [^false]. + receiver isSelf ifTrue: [^false]. + receiver isSuper ifTrue: [^false]. + receiver isMethodArgument ifTrue: [^false]. + self hasVolatileReceiver ifFalse: [^false]. + (receiver isImmediate + and: [arguments conform: [:arg | arg isImmediate or: [arg isBlockNode]]]) + ifTrue: [^false]. + receiver hasAssign ifTrue: [^true]. + receiver isMessageNode ifTrue: [ ^true ]. + ^self hasVolatileArguments ! ! -!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -canStartIdentifier: aCharacter - ^aCharacter isLetter or: [aCharacter = $_] +!SMessageNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + receiver nodesDo: aBlock includingDeclarations: aBoolean. + arguments do: [:arg | arg nodesDo: aBlock includingDeclarations: aBoolean]. + selector nodesDo: aBlock includingDeclarations: aBoolean ! ! -!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -peekForIdentifier: aStream - | char next | - char := aStream peek. - (self canBeInIdentifier: char) ifTrue: [ - aStream skip: 1. - ^true]. - char = $. ifFalse: [^false]. - aStream prev isLetter ifFalse: [ - aStream skip: 1. - ^false]. - next := aStream skip: 2; peek. - next isNil ifTrue: [ - aStream skip: -1. - ^false]. - ^next isLetter ifFalse: [aStream skip: -1]; yourself +!SCascadeMessageNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitCascadeMessage: self ! ! -!SCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -protect: aBlock - ^aBlock value +!SCascadeMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +cascade: aCascadeNode + cascade := aCascadeNode. + receiver := cascade receiver ! ! -!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -classBinding - ^class +!SCascadeMessageNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +from: aMessageNode + arguments := aMessageNode arguments. + receiver := aMessageNode receiver. + selector := aMessageNode selector. + inlined := aMessageNode isInlined. + stretch := aMessageNode stretch. + comments := aMessageNode comments ! ! -!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -classBinding: aSpecies - | instance | - class := aSpecies. - instance := aSpecies instanceClass. - (instance respondsTo: #configureCompiler) - ifTrue: [instance configureCompiler: self] +!SCascadeMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isCascadeMessage + ^true ! ! -!SCompiler methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize: aDictionary - class := aDictionary at: #UndefinedObject ifAbsent: nil +!SCascadeMessageNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nodesDo: aBlock includingDeclarations: aBoolean + aBlock value: self. + arguments do: [:arg | arg nodesDo: aBlock includingDeclarations: aBoolean] ! ! -!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -compile: aString - result := self smalltalkCompiler compileMethod: aString. - ^result method +!SReturnNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitReturn: self ! ! -!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -parse: aString - result := self smalltalkCompiler parseMethod: aString. - ^result ast +!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +expression + ^expression ! ! -!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -smalltalkCompiler - ^ SSmalltalkCompiler new frontend: self +!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +expression: node + expression := node ! ! -!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -smalltalkParser - ^ self smalltalkCompiler parser +!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +return: aSmalltalkToken + return := aSmalltalkToken ! ! -!SCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -smalltalkScanner - ^ self smalltalkCompiler scanner +!SReturnNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasAssign + ^expression hasAssign ! ! -!SCompiler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -forClass: aClass - | c | - c := aClass ifNil: [UndefinedObject]. - self classBinding: c +!SReturnNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isReturn + ^true ! ! -!SCompiler class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -compile: aString in: aClass - | compiler | - compiler := self forClass: aClass. - ^compiler compile: aString +!SReturnNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + expression nodesDo: aBlock includingDeclarations: aBoolean ! ! -!SCompiler class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -parse: aString in: aClass - | compiler | - compiler := self forClass: aClass. - ^compiler parse: aString +!SScriptNode methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addChild: aBlockNode + children add: aBlockNode ! ! -!SCompiler class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! -forClass: aClass - ^self new forClass: aClass +!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addStatements: anOrderedCollection + statements addAll: anOrderedCollection ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visit: aParseNode - ^aParseNode notNil ifTrue: [aParseNode acceptVisitor: self] +!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +identifiers + | result | + result := OrderedCollection new. + self nodesDo: [:node | node isIdentifier ifTrue: [result add: node]]. + ^result withoutDuplicates ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitAssignment: anAssignmentNode - ^self visitParseNode: anAssignmentNode +!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + statements := OrderedCollection new. + arguments := #(). + temporaries := #(). + children := OrderedCollection new ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitBlock: aBlockNode - ^self visitParseNode: aBlockNode +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +arguments + ^arguments ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitBraceNode: aBraceNode - ^self visitParseNode: aBraceNode +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +arguments: aCollection + arguments := aCollection ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitCascade: aCascadeNode - ^self visitParseNode: aCascadeNode +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +children + ^children ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitCascadeMessage: aCascadeMessageNode - ^self visitMessage: aCascadeMessageNode +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentSize + ^scope environmentSize ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitForeignNode: anForeignNode - self visitLiteral: anForeignNode +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +realScript + self subclassResponsibility ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitIdentifier: anIdentifierNode - ^self visitParseNode: anIdentifierNode +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +statements + ^statements ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitLiteral: aLiteralNode - ^self visitParseNode: aLiteralNode +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +temporaries + ^temporaries ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitMessage: aMessageNode - ^self visitParseNode: aMessageNode +!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +temporaries: aCollection + temporaries := aCollection ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitMethod: aMethodNode - ^self visitParseNode: aMethodNode +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +bindLocals + arguments do: [:arg | arg defineArgumentIn: scope]. + temporaries do: [:temp | temp checkLowercase; defineTemporaryIn: scope]. + children do: [:block | block bindLocals] ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitNumberNode: aNumberNode - ^self visitLiteral: aNumberNode +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +positionLocals + scope positionLocals. + children do: [:b | b positionLocals] +! ! + +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +reference: aBinding + aBinding beReferencedFrom: self +! ! + +!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +scope + ^scope ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitParseNode: aParseNode - ^self subclassResponsibility +!SScriptNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasAssign + statements do: [:s | s hasAssign ifTrue: [^true]]. + ^false ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitPragma: aPragmaNode - ^self visitParseNode: aPragmaNode +!SScriptNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + aBoolean ifTrue: [ + arguments do: [:a | a nodesDo: aBlock includingDeclarations: aBoolean]. + temporaries do: [:a | a nodesDo: aBlock includingDeclarations: aBoolean]]. + statements do: [:s | s nodesDo: aBlock includingDeclarations: aBoolean] ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitReturn: aReturnNode - ^self visitParseNode: aReturnNode +!SScriptNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +useSelf + scope captureSelf ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitSelector: aSelectorNode - ^self visitParseNode: aSelectorNode +!SBlockNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitBlock: self ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitString: aStringNode - ^self visitLiteral: aStringNode +!SBlockNode methodsFor: 'emitting - inlined' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beInlined + inlined := true. + arguments do: [:arg | arg binding beInlined] ! ! -!SParseTreeVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitSymbolicPragma: aPragmaNode - ^self visitPragma: aPragmaNode +!SBlockNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +buildBlock + | block | + self isInlined ifTrue: [ ^ nil ]. + block := CompiledBlock new. + ^ block + blockNumber: index; + argumentCount: arguments size; + tempCount: scope stackSize; + environmentCount: scope environmentSize; + capturesSelf: scope capturesSelf; + capturesHome: scope capturesHome ! ! -!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! -analyzeAssignment: anAssignmentNode - anAssignmentNode assignees - do: [:v | self analyzeIdentifier: v assignee: true] +!SBlockNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +captureHome + scope captureEnvironment: self ast ! ! -!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! -analyzeBlock: aBlockNode while: aBlock - aBlockNode isInlined - ifFalse: [aBlockNode index: aBlockNode compiler blockIndex]. - self analyzeScript: aBlockNode while: aBlock +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environmentIndexOf: aParseNode + ^scope environmentIndexOf: aParseNode ! ! -!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! -analyzeIdentifier: anIdentifierNode - self analyzeIdentifier: anIdentifierNode assignee: false +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isBlockNode + ^true ! ! -!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! -analyzeIdentifier: anIdentifierNode assignee: aBoolean - | script binding | - anIdentifierNode resolveAssigning: aBoolean. - aBoolean ifTrue: [anIdentifierNode beAssigned]. - script := anIdentifierNode compiler activeScript. - binding := anIdentifierNode binding. - script reference: binding. - binding isLocal ifTrue: [binding := script scope captureLocal: binding]. - anIdentifierNode binding: binding +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isEvaluable + ^self isNullary ! ! -!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! -analyzeMessage: aMessageNode - inliner inline: aMessageNode. - aMessageNode isInlined ifFalse: [aMessageNode compiler noticeSend] +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isInlined + ^inlined ! ! -!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! -analyzeMethod: aMethodNode while: aBlock - self analyzeScript: aMethodNode while: aBlock +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isNullary + ^arguments isEmpty ! ! -!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! -analyzeReturn: aReturnNode - aReturnNode compiler activeScript realScript captureHome +!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +usesHome + ^inlined + ifTrue: [children anySatisfy: [:block | block usesHome]] + ifFalse: [scope capturesHome] ! ! -!SSemanticVisitor methodsFor: 'analizing' stamp: 'KenD 28/Jun/2026 13:27:40'! -analyzeScript: aScriptNode while: aBlock - aScriptNode compiler activate: aScriptNode while: aBlock +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +index + ^index ! ! -!SSemanticVisitor methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - inliner := MessageInliner new +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +index: aNumber + index := aNumber ! ! -!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitAssignment: anAssignmentNode - self analyzeAssignment: anAssignmentNode. - anAssignmentNode expression acceptVisitor: self +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parent + ^parent ! ! -!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitBlock: aBlockNode - self - analyzeBlock: aBlockNode - while: [aBlockNode statements do: [:node | node acceptVisitor: self]] +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +parent: aScriptNode + parent := aScriptNode addChild: self ! ! -!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitBraceNode: aBraceNode - aBraceNode isLiteral - ifFalse: [aBraceNode asMessageNode acceptVisitor: self] +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +realParent + ^parent realScript ! ! -!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitCascade: aCascadeNode - aCascadeNode receiver acceptVisitor: self. - aCascadeNode messages do: [:msg | msg acceptVisitor: self] +!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +realScript + ^inlined ifTrue: [parent realScript] ifFalse: [self] ! ! -!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitIdentifier: anIdentifierNode - self analyzeIdentifier: anIdentifierNode +!SBlockNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + inlined := false. + scope := BlockScope on: self ! ! -!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitMessage: aMessageNode - self analyzeMessage: aMessageNode. - aMessageNode receiver acceptVisitor: self. - aMessageNode arguments do: [:arg | arg acceptVisitor: self] +!SMethodNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitMethod: self ! ! -!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitMethod: aMethodNode - self analyzeMethod: aMethodNode while: [ - aMethodNode bindLocals. - aMethodNode statements do: [:s | s acceptVisitor: self]. - aMethodNode positionLocals] +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +buildMethod + | cm encoder treecodes | + cm := self methodClass withAll: self literals. + cm + blockCount: compiler blockCount; + tempCount: scope stackSize; + argumentCount: arguments size; + environmentCount: scope environmentSize; + capturesSelf: scope capturesSelf; + hasEnvironment: self needsEnvironment; + hasFrame: self needsFrame; + selector: self selector; + sourceObject: compiler sourceCode; + classBinding: compiler frontend classBinding. + cm pragma: pragma. + cm blocks do: [ :block | block method: cm ]. + encoder := TreecodeEncoder new method: cm. + treecodes := self acceptVisitor: encoder. + ^ cm treecodes: treecodes ! ! -!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitParseNode: aParseNode - " - do nothing - " +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +captureHome ! ! -!SSemanticVisitor methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitReturn: aReturnNode - aReturnNode expression acceptVisitor: self. - self analyzeReturn: aReturnNode +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +literals + | literals v l | + literals := OrderedCollection new. + pragma isUsed + ifTrue: [ literals add: pragma name ]. + self + nodesDo: [ :n | + n isLiteral + ifTrue: [ v := n value. + v isSmallInteger + ifFalse: [ literals add: v ] ]. + n isMessageNode + ifTrue: [ literals add: n symbol ]. + n isBraceNode + ifTrue: [ n isLiteral + ifTrue: [ self halt ] + ifFalse: [ literals + add: #Array; + add: #new:; + add: #at:put:; + add: #yourself ] ]. + (n isIdentifier + and: [ l := n binding literal. + l notNil ]) + ifTrue: [ literals add: l ]. + (n isBlockNode andNot: [ n isInlined ]) + ifTrue: [ literals add: n buildBlock ] ]. + ^ literals withoutDuplicates ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -compiledBlockIndexOf: aBlockNode - | index | - index := method - findFirst: [:literal | literal isBlock - and: [literal blockNumber == aBlockNode index]]. - ^index +!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +methodClass + | type | + type := pragma type. + type = #callback + ifTrue: [ ^ CallbackMethod ]. + type = #callout + ifTrue: [ ^ CalloutMethod ]. + ^ CompiledMethod ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeArgument: anInteger env: environment - | encoded | - encoded := self encodedEnvironment: environment. - self - nextPut: ArgumentId; - nextIntegerPut: anInteger; - nextIntegerPut: encoded +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +compiler: aSmalltalkCompiler + super compiler: aSmalltalkCompiler. + scope := MethodScope new script: self. + pragma := aSmalltalkCompiler pragmaNode ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeClosureElements: aBlockNode - | scope parent | - scope := aBlockNode scope. - parent := aBlockNode realParent. - ^Array streamContents: [:s | - scope capturesSelf ifTrue: [ s nextPut: CaptureSelf ]. - scope capturedEnvironments do: [:e | | index | - e == parent ifTrue: [s nextPut: CaptureEnvironment] ifFalse: [ - index := aBlockNode environmentIndexOf: e. - self ASSERT: index notNil. - s nextPut: CaptureEnvironmentValue; nextPut: index]]. - scope capturedArguments do: [:a | | binding | - binding := aBlockNode parent scope resolve: a name. - s nextPut: binding environmentCaptureType; nextPut: binding index]] - +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +pragma + ^pragma ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeDynamicVar: name - stream nextPut: DynamicVarId. - self nextSymbolPut: name +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +pragma: anObject + pragma := anObject ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeFalse - stream nextPut: FalseId +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +realScript + ^self ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeLoadRvisitingReceiver - stream nextPut: LoadRvisitingReceiverId +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +selector + ^selector value ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeNestedDynamicVar: name - stream nextPut: NestedDynamicVarId. - self nextLiteralPut: name +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +selector: aSelectorNode + selector := aSelectorNode ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeNil - stream nextPut: NilId +!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +selectorNode + ^selector ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodePopR - stream nextPut: PopRid +!SMethodNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +environmentIndexOf: aParseNode + ^nil +! ! + +!SMethodNode methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +header + " + (Object >> #printOn:) ast header + " + | interval | + interval := selector stretch. + arguments notEmpty + ifTrue: [interval := interval start thru: arguments last stretch end]. + ^compiler sourceCode copyFrom: interval start to: interval end ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodePushR - stream nextPut: PushRid +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isHeadless + ^selector isNil ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeSelf - stream nextPut: SelfId +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isMethod + ^true ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeSuper - stream nextPut: SuperId +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +needsEnvironment + ^scope environmentSize > 0 + or: [children anySatisfy: [:block | block usesHome]] ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeTemporary: anInteger env: environment - | encoded | - encoded := self encodedEnvironment: environment. - self - nextPut: TemporaryId; - nextIntegerPut: anInteger; - nextIntegerPut: encoded +!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +needsFrame + scope stackSize > 0 ifTrue: [ ^ true ]. + arguments size > 16 ifTrue: [ ^ true ]. + compiler hasSends ifTrue: [ ^ true ]. + compiler hasBlocks ifTrue: [ ^ true ]. + ^ false ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeTrue - stream nextPut: TrueId +!SMethodNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +nodesDo: aBlock includingDeclarations: aBoolean + super nodesDo: aBlock includingDeclarations: aBoolean. + (aBoolean and: [selector notNil]) ifTrue: [aBlock value: selector] ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodedEnvironment: aLocalEnvironment - aLocalEnvironment isStack - ifTrue: [ ^ aLocalEnvironment isInlinedArgument - ifTrue: [ -1 ] - ifFalse: [ -2 ] ]. - aLocalEnvironment isCurrent - ifTrue: [ ^ 0 ]. - ^ aLocalEnvironment index +!SSelectorNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitSelector: self ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextBigIntegerPut: anInteger - stream - nextPut: 16r80; - nextInt64Put: anInteger +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 30/Jun/2026, 3:25:59 pm (UTC)'! +addKeyword: aSelectorNode + keywords isNil ifTrue: [keywords := OrderedCollection new]. + keywords add: aSelectorNode ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextBooleanPut: aBoolean - stream nextPut: aBoolean asParameter - +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +end + stretch end ifNotNil: [:e | ^e]. + ^keywords notNil ifTrue: [keywords last end] ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextIntegerPut: anInteger - | value | - (anInteger > 127 or: [ anInteger < -127 ]) - ifTrue: [ ^ self nextBigIntegerPut: anInteger ]. - value := anInteger >= 0 - ifTrue: [ anInteger ] - ifFalse: [ anInteger + 16r100 ]. - stream nextPut: value +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +keywords + ^keywords isNil ifTrue: [{self}] ifFalse: [keywords] ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextLiteralPut: anObject - | index | - index := method - indexOf: anObject - ifAbsent: [ self ASSERT: false ]. - self nextIntegerPut: index +!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +positions + ^self keywords collect: [:node | node position] ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextPut: anInteger - stream nextPut: anInteger +!SSelectorNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +hasSymbol + ^symbol isSymbol ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextPutAll: aCollection - stream nextPut: aCollection size; nextPutAll: aCollection +!SSelectorNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isSelector + ^true ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextSymbolPut: aSymbol - | index | - index := method - indexOf: aSymbol asSymbol - ifAbsent: [ self ASSERT: false ]. - self nextIntegerPut: index +!SSelectorNode methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +isBinary + ^symbol isBinary ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextTypePut: anInteger - stream nextPut: anInteger +!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +symbol + ^symbol ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitAssignment: anAssignmentNode - | assignees | - self nextTypePut: AssignmentId. - assignees := anAssignmentNode assignees. - self nextIntegerPut: assignees size. - assignees do: [ :node | node acceptVisitor: self ]. - anAssignmentNode expression acceptVisitor: self +!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +symbol: aString + symbol := aString asSymbol ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitBlock: aBlockNode - | args inlined | - self nextTypePut: BlockId. - inlined := aBlockNode isInlined. - self nextBooleanPut: inlined. - inlined - ifTrue: [ args := aBlockNode arguments collect: [ :id | id binding index ]. - self nextPutAll: args asArray ] - ifFalse: [ | index captured | - index := self compiledBlockIndexOf: aBlockNode. - self nextPut: index. - captured := self encodeClosureElements: aBlockNode. - self nextPutAll: captured ]. - self visitScript: aBlockNode +!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +value + ^symbol ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitBraceNode: aBraceNode - aBraceNode isLiteral - ifTrue: [self visitLiteral: aBraceNode asLiteralNode] - ifFalse: [self visitCascade: aBraceNode asMessageNode] +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +acceptVisitor: aVisitor + self isFFI ifTrue: [^aVisitor visitFFIPragma: self]. + self isPrimitive ifTrue: [^aVisitor visitPrimitivePragma: self]. + self isSymbolic ifTrue: [^aVisitor visitSymbolicPragma: self] ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitCascade: aCascadeNode - | messages | - self nextTypePut: CascadeId. - aCascadeNode receiver acceptVisitor: self. - messages := aCascadeNode messages. - self nextIntegerPut: messages size. - messages do: [ :node | self visitCascadeMessage: node ] +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ffi: cc name: aString with: anFFIDescriptor + type := cc. + name := aString. + info := anFFIDescriptor ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitCascadeMessage: aCascadeMessageNode - | arguments | - self nextSymbolPut: aCascadeMessageNode selector symbol. - arguments := aCascadeMessageNode arguments. - self nextIntegerPut: arguments size. - arguments do: [ :arg | arg acceptVisitor: self ] +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ffi: aString with: anFFIDescriptor + type := #ffi. + name := aString. + info := anFFIDescriptor ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitIdentifier: anIdentifierNode - self nextTypePut: IdentifierId. - anIdentifierNode binding encodeUsing: self +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +info + ^info ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitLiteral: aLiteralNode - | index | - index := method indexOf: aLiteralNode value. - self - nextTypePut: LiteralId; - nextIntegerPut: index. - index = 0 - ifTrue: [ self nextIntegerPut: aLiteralNode value ] +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isUsed + ^type notNil ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitMessage: aMessageNode - | arguments | - self - nextTypePut: MessageId; - nextBooleanPut: aMessageNode isInlined; - nextSymbolPut: aMessageNode selector symbol. - aMessageNode receiver acceptVisitor: self. - arguments := aMessageNode arguments. - self nextIntegerPut: arguments size. - arguments do: [ :arg | arg acceptVisitor: self ] +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name + ^name ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitMethod: aMethodNode - | pragma | - self nextTypePut: MethodId. - pragma := aMethodNode pragma. - pragma isUsed - ifTrue: [ self nextTypePut: PragmaId. - pragma name - ifNotNil: [ self nextSymbolPut: pragma name ] - ifNil: [ self nextPut: 0 ] ]. - self visitScript: aMethodNode. - ^ stream contents +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +primitive: anInteger name: aString + type := #primitive. + name := aString. + info := anInteger ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitParseNode: aParseNode - ^self ASSERT: false +!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +type + ^type ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitReturn: aReturnNode - self - nextTypePut: ReturnId; - nextBooleanPut: script realScript isMethod. - - aReturnNode expression acceptVisitor: self +!SSymbolicToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +is: anObject + ^value == anObject ! ! -!TreecodeEncoder methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -visitScript: aScriptNode - | prev statements | - prev := script. - script := aScriptNode. - statements := aScriptNode statements. - self nextIntegerPut: statements size. - statements do: [ :node | node acceptVisitor: self ]. - script := prev +!SSymbolicToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +value + ^value ! ! -!TreecodeEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - stream := #[] writeStream +!SSymbolicToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +value: anObject + value := anObject ! ! -!TreecodeEncoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -method: aCompiledMethod - method := aCompiledMethod +!SDelimiterToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +asSelectorNode + ^compiler selectorNode symbol: value asString; stretch: stretch ! ! -!TreecodeEncoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initializeBindingIds - | named | - named := self addNamespaceAs: #BindingIds. - named - at: #NilId put: 1; - at: #TrueId put: 2; - at: #FalseId put: 3; - at: #ArgumentId put: 4; - at: #TemporaryId put: 5; - at: #SelfId put: 6; - at: #SuperId put: 7; - at: #DynamicVarId put: 14; - at: #NestedDynamicVarId put: 15; - at: #PushRid put: 50; - at: #PopRid put: 51 +!SDelimiterToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +beCharacter + value := value isCharacter ifTrue: [value] ifFalse: [value first] ! ! - -!TreecodeEncoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initializeTreecodeIds - | named | - named := self addNamespaceAs: #TreecodeIds. - named - at: #MethodId put: 101; - at: #BlockId put: 102; - at: #IdentifierId put: 103; - at: #LiteralId put: 104; - at: #MessageId put: 105; - at: #CascadeId put: 106; - at: #BraceId put: 107; - at: #AssignmentId put: 108; - at: #ReturnId put: 109; - at: #PragmaId put: 110 + +!SDelimiterToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +value: aString + super value: aString asSymbol ! ! -!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -capturesSelf - ^ captureSelf +!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +endsExpression + ^value = $. or: [value = $]] or: [value = $)] or: [value = $}] ! ! -!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -describe: identifier - | binding type | - binding := self resolve: identifier. - type := self class name asLowercase allButLast: 'scope' size. - ^binding description , ' of ' , type +!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isAssignment + ^self is: #':=' ! ! -!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentSize - ^envSize +!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isDelimiter + ^true ! ! -!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -scopeOf: aString - | s | - s := self scriptDefining: aString. - ^s notNil ifTrue: [s scope] +!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +asIdentifierNode + ^compiler identifierNode + name: value; + stretch: stretch; + comments: comments ! ! -!ScriptScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -stackSize - ^stackSize +!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +asSelectorNode + ^compiler selectorNode symbol: value; stretch: stretch ! ! -!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -defineArgument: identifier - | binding | - (self resolves: identifier) ifTrue: [self redefinitionError: identifier]. - binding := ArgumentBinding new name: identifier. - arguments define: identifier as: binding. - ^binding +!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isStringToken + ^true ! ! -!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -defineTemporary: identifier - | binding | - (temporaries defines: identifier) - ifTrue: [self redefinitionError: identifier]. - binding := TemporaryBinding new name: identifier. - temporaries define: identifier as: binding. - ^binding +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +hasSymbol + ^value isSymbol ! ! -!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -defines: aString - ^(temporaries defines: aString) or: [arguments defines: aString] +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isBinary + ^value isSymbol ! ! -!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -localBindings - ^arguments values , temporaries values +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isDelimitedIdentifier + ^value first = ${ ! ! -!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -resolveLocal: aString - (temporaries at: aString) ifNotNil: [:binding | ^binding]. - ^arguments at: aString +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isKeyword + ^value last = $: ! ! -!ScriptScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -resolves: aString - ^(self resolve: aString) isDynamic not +!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +isNameToken + ^(self isKeyword or: [self isBinary]) not ! ! -!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -growEnvironment - ^envSize := envSize + 1 +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assign: value within: anEggRuntime + ^ self subclassResponsibility ! ! -!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -growStack - ^stackSize := stackSize + 1 +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assign: value within: anEvaluationContext ifUnbound: aClosure + ^self assign: value within: anEvaluationContext + ! ! -!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionDefinedArguments - arguments withIndexDo: [:binding :index | binding index: index] +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isArgument + ^false ! ! -!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionDefinedLocals - self positionDefinedTemporariesIn: self; positionDefinedArguments +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isAssociation + ^false ! ! -!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionDefinedTemporariesIn: aScriptScope - temporaries do: [:binding | | position | - position := binding isInStack - ifTrue: [aScriptScope growStack] - ifFalse: [aScriptScope growEnvironment]. - binding index: position] +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isClassBinding + ^false ! ! -!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionLocals - self positionDefinedLocals +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isClassVar + ^false ! ! -!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -realScope - ^script realScript scope +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isDynamic + ^ false ! ! -!ScriptScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -redefinitionError: name - | scope description | - scope := self scopeOf: name. - description := scope describe: name. - script compiler - warning: name , ' already declared as ' , description - at: script stretch +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isInstVar + ^false ! ! -!ScriptScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - arguments := StaticBinder new. - temporaries := StaticBinder new. - stackSize := envSize := 0. - captureSelf := false. +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isLiteral + ^false ! ! -!ScriptScope methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -script: aScriptNode - script := aScriptNode +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isPoolVar + ^false ! ! -!ScriptScope class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! -on: aScriptNode - ^self new script: aScriptNode +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isSelf + ^false ! ! -!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureArgument: anArgumentBinding - | name | - name := anArgumentBinding name. - ^captured at: name ifAbsentPut: [| transferred copy | - transferred := self parent transferLocal: name. - copy := self copyLocal: transferred. - copy declaration: transferred declaration] +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isSuper + ^false ! ! -!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -localBindings - ^super localBindings , captured values +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isTemporary + ^false ! ! -!BlockScope methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -resolve: aString - (self resolveLocal: aString) ifNotNil: [:binding | ^binding]. - ^self parent resolve: aString +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name + ^self printString ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureEnvironment: aScriptNode - script == aScriptNode ifTrue: [^self]. - (environments includesIdentical: aScriptNode) ifTrue: [^self]. - self realParent captureEnvironment: aScriptNode. - aScriptNode isMethod - ifTrue: [environments addFirst: aScriptNode] - ifFalse: [environments addLast: aScriptNode] +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +valueWithin: anEvaluationContext + ^ self subclassResponsibility ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -capturedEnvironmentIndexOf: aScriptNode - | index | - aScriptNode realScript == script realScript - ifTrue: [ ^ nil ]. - index := environments indexOf: aScriptNode ifAbsent: nil. - self ASSERT: index notNil. - ^self capturesSelf ifTrue: [ index + 1 ] ifFalse: [ index ] +!SBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +valueWithin: anEvaluationContext ifUnbound: aClosure + ^self valueWithin: anEvaluationContext ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -copyLocal: binding - ^script isInlined ifTrue: [binding] ifFalse: [binding copy beInArray] +!SBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^self subclassResponsibility ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentIndexOf: aScriptNode - " - temporal compatibility - " - (aScriptNode isKindOf: SScriptNode) - ifFalse: [ self ASSERT: false. ^nil ]. - ^self capturedEnvironmentIndexOf: aScriptNode +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assign: value within: anEvaluationContext + anEvaluationContext storeAssociation: association value: value ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentSizeUpToCapturedArguments - ^self environmentSizeUpToEnvironments + self capturedArguments size +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index + ^ index ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentSizeUpToEnvironments - | receiver | - receiver := self capturesSelf ifTrue: [ 1 ] ifFalse: [ 0 ]. - ^receiver + environments size +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index: anInteger + index := anInteger ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -parent - ^script parent scope +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isAssociation + ^true ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionCapturedArgument: anArgumentBinding - anArgumentBinding index: self growEnvironment +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isConstant + ^ false ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionCapturedLocals - script isInlined ifTrue: [^self]. - envSize := self environmentSizeUpToEnvironments. - captured do: [:binding | - binding isArgument - ifTrue: [self positionCapturedArgument: binding] - ifFalse: [self positionCapturedTemporary: binding]] +!SAssociationBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +valueWithin: anEvaluationContext + ^ anEvaluationContext loadAssociationValue: association ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionCapturedTemporary: aTemporaryBinding - | outest index declaration | - outest := self scriptDefining: aTemporaryBinding name. - index := self capturedEnvironmentIndexOf: outest realScript. - aTemporaryBinding environmentIndex: index. - declaration := outest scope resolve: aTemporaryBinding name. - self ASSERT: declaration index isInteger. - aTemporaryBinding index: declaration index +!SAssociationBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +association + ^association ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionDefinedArgumentsIn: aScriptScope - arguments do: [:binding | | index | - index := binding isInArray - ifTrue: [aScriptScope growEnvironment] - ifFalse: [aScriptScope growStack]. - binding index: index] +!SAssociationBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +association: anAssociation + association := anAssociation ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionDefinedLocals - | real | - script isInlined - ifTrue: [ - real := self realScope. - self - positionDefinedTemporariesIn: real; - positionDefinedArgumentsIn: real] - ifFalse: [super positionDefinedLocals] +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assign: value within: anEvaluationContext ifUnbound: aClosure + + cache ifNil: [ self lookupWithin: anEvaluationContext ]. + cache ifNil: [ ^ aClosure value ]. + cache assign: value within: anEvaluationContext ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionLocals - self positionCapturedLocals. - super positionLocals +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isDynamic + ^true ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -realParent - ^script realParent scope +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +lookupWithin: anEvaluationContext + cache := anEvaluationContext staticBindingFor: name ! ! -!BlockScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -transferLocal: name - | binding copy | - (self resolveLocal: name) ifNotNil: [:b | ^b]. - binding := self parent transferLocal: name. - copy := self copyLocal: binding. - captured at: name put: copy. - ^copy +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name + name ! ! -!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureLocal: aLocalBinding - (self defines: aLocalBinding name) ifTrue: [^aLocalBinding]. - ^aLocalBinding isTemporary - ifTrue: [self captureTemporary: aLocalBinding] - ifFalse: [self captureArgument: aLocalBinding] +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name: aSymbol + name := aSymbol ! ! -!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureSelf - captureSelf ifTrue: [^self]. - captureSelf := true. - self parent captureSelf +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream + nextPutAll: 'DinamicVarId. '; + nextPutAll: name printString ! ! -!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureTemporary: aTemporaryBinding - | name | - name := aTemporaryBinding name. - (self defines: name) ifTrue: [^aTemporaryBinding]. - ^captured at: name ifAbsentPut: [| parent declaration transferred copy | - parent := self parent. - declaration := parent scriptDefining: name. - self realScope captureEnvironment: declaration realScript. - transferred := parent transferLocal: name. - copy := self copyLocal: transferred. - copy isInArray ifTrue: [aTemporaryBinding beInArray]. - copy declaration: transferred declaration] +!SDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +valueWithin: anEvaluationContext ifUnbound: aClosure + + cache ifNil: [ self lookupWithin: anEvaluationContext ]. + cache ifNil: [ ^ aClosure value ]. + ^ cache valueWithin: anEvaluationContext ! ! -!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -capturedArguments - ^captured select: [:b | b isArgument] +!SDynamicBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^ aTreecodeDecoder decodeDynamicVar ! ! -!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -capturedEnvironments - ^environments +!SNestedDynamicBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +lookupWithin: anEvaluationContext + cache := anEvaluationContext staticBindingForNested: name ! ! -!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -capturesHome - ^self home notNil +!SNestedDynamicBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^ aTreecodeDecoder decodeNestedDynamicVar ! ! -!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -environments - " - compatibility, removes the home environment - " - | first | - environments isEmpty ifTrue: [^#()]. - first := environments first. - ^first isMethod ifTrue: [environments allButFirst] ifFalse: [environments] +!SInstVarBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assign: value within: anEvaluationContext + anEvaluationContext instanceVarAt: index put: value +! ! + +!SInstVarBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isInstVar + ^true ! ! -!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -home - | first | - environments isEmpty ifTrue: [^nil]. - first := environments first. - ^first isMethod ifTrue: [first] +!SInstVarBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream nextPutAll: 'InstVarId. '; nextPutAll: index printString ! ! -!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -resolveLocal: aString - (super resolveLocal: aString) ifNotNil: [:binding | ^binding]. - ^captured at: aString +!SInstVarBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index + ^index ! ! -!BlockScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -scriptDefining: aString - (self defines: aString) ifTrue: [^script]. - ^self parent scriptDefining: aString +!SInstVarBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index: anInteger + index := anInteger ! ! -!BlockScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - captured := StaticBinder new. - environments := OrderedCollection new +!SInstVarBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +valueWithin: anEvaluationContext + ^ anEvaluationContext instanceVarAt: index ! ! -!MethodScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureEnvironment: aScriptNode - self ASSERT: aScriptNode == script +!SInstVarBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeInstVar ! ! -!MethodScope methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -transferLocal: name - ^self resolveLocal: name +!SLiteralBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isLiteral + ^true ! ! -!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureLocal: aLocalBinding - self ASSERT: (self resolveLocal: aLocalBinding name) notNil. - ^aLocalBinding +!SLiteralBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^self new ! ! -!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureSelf - captureSelf := true. +!SFalseBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream nextPutAll: 'FalseId' +! ! +!SFalseBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +value + ^false ! ! -!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentIndexOf: aScriptNode - self ASSERT: aScriptNode == script. - ^nil +!SFalseBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +valueWithin: anEvaluationContext + ^ anEvaluationContext false ! ! -!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -resolve: aString - (self resolveLocal: aString) ifNotNil: [ :binding | ^ binding ]. - (self resolvePseudo: aString) ifNotNil: [ :binding | ^ binding ]. - ^ DynamicBinding named: aString +!SNilBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream nextPutAll: 'NilId' ! ! -!MethodScope methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -scriptDefining: aString - (self resolveLocal: aString) ifNotNil: [^script]. - self ASSERT: false. +!SNilBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +value ^nil ! ! -!MethodScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - self initializePseudoVars +!SNilBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +valueWithin: anEvaluationContext + ^ anEvaluationContext nil ! ! -!MethodScope methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initializePseudoVars - pseudo := StaticBinder new. - pseudo - at: 'nil' put: NilBinding new; - at: 'true' put: TrueBinding new; - at: 'false' put: FalseBinding new; - at: 'self' put: SelfBinding new; - at: 'super' put: SuperBinding new +!SLocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +environment + ^environment ! ! -!MethodScope methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! -resolvePseudo: aString - ^pseudo at: aString - +!SLocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +environment: anInteger + environment := anInteger ! ! -!Binding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! -beReferencedFrom: aScriptNode - +!SLocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index + ^position ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -canBeAssigned - ^true +!SLocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index: anInteger + position := anInteger ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -declaration - ^self +!SLocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isInStack + self ASSERT: false. + ^ environment = 0 ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeUsing: aTreecodeEncoder - self ASSERT: false +!SArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assign: value within: anEvaluationContext + self halt ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +!SArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! isArgument - ^false + ^true ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isClassBinding - ^false +!SArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isInlined + ^ environment = -1 ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isClassVariable - ^false +!SArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream + nextPutAll: 'SArgument '; + print: position; + nextPutAll: ' @ env '; + print: environment ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isConstantBinding - ^false +!SArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +valueWithin: anEvaluationContext + ^ anEvaluationContext argumentAt: position in: environment ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isDynamic - ^false +!SArgumentBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeArgument ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isGlobal - ^false +!STemporaryBinding methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assign: value within: anEvaluationContext + anEvaluationContext temporaryAt: position in: environment put: value ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isInStack - ^false +!STemporaryBinding methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream + nextPutAll: 'STemporary '; + print: position; + nextPutAll: ' @ env '; + print: environment ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isInstVar - ^false +!STemporaryBinding methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +valueWithin: anEvaluationContext + ^ anEvaluationContext temporaryAt: position in: environment ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isLiteral - ^false +!STemporaryBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isInCurrentEnvironment + ^environment = 1 ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isLocal - ^false +!STemporaryBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isTemporary + ^true ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isPoolVariableBinding - ^false +!STemporaryBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeTemporary ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +!SSelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! isSelf - ^false + ^true ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isSelfOrSuper - ^self isSelf or: [self isSuper] +!SSelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +valueWithin: anEvaluationContext + ^ anEvaluationContext receiver ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isSuper - ^false +!SSelfBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream nextPutAll: 'SelfId' ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isTemporary - ^false +!SSelfBinding class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^self new ! ! -!Binding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -literal - ^nil +!SSuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isSelf + ^false ! ! -!Binding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -name - ^name +!SSuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isSuper + ^true ! ! -!Binding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -name: aString - name := aString +!SSuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream nextPutAll: 'SuperId' ! ! -!Binding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! -printNameOn: aStream - aStream - print: name +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^self subclassResponsibility +! ! +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isAssignment + ^false ! ! -!Binding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! -printOn: aStream - self printNameOn: aStream. - aStream - nextPutAll: ' ('. - super printOn: aStream. - aStream nextPutAll: ')' +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isCascade + ^false ! ! -!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -beReferencedFrom: aScriptNode - "a dynamic binding could refer to an ivar, so we have to be conservative" - aScriptNode useSelf +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isCascadeMessage + ^false ! ! -!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeUsing: aTreecodeEmitter - aTreecodeEmitter encodeDynamicVar: name +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isIdentifier + ^false ! ! -!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isDynamic - ^true +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isLiteral + ^false ! ! -!DynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -literal - ^name asSymbol +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isMessage + ^false ! ! -!DynamicBinding class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -default - ^Default ifNil: [Default := self new name: ''] +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isReturn + ^false ! ! -!DynamicBinding class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -named: aString - | index first second | - index := aString indexOf: $.. - index = 0 ifTrue: [ ^self new name: aString ]. - first := aString copyFrom: 1 to: index - 1. - second := aString copyFrom: index + 1 to: aString size. - ^NestedDynamicBinding new name: { first. second } +!SExpression methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isSuper + ^ false ! ! -!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeUsing: aTreecodeEmitter - aTreecodeEmitter encodeNestedDynamicVar: name +!SExpression methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isInstVar + ^false ! ! -!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -literal - ^name collect: [ :n | n asSymbol] +!SExpression methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isMethod + ^false ! ! -!NestedDynamicBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -printNameOn: aStream - name do: [ :n | aStream nextPutAll: n ] separatedBy: [ aStream nextPut: $. ] +!SExpression methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + self printOn: aStream indent: 0 ! ! -!LiteralBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isLiteral - ^true +!SExpression methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream indent: anInteger + super printOn: aStream ! ! -!FalseBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeUsing: aTreecodeEmitter - aTreecodeEmitter encodeFalse +!SAssignment methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitAssignment: self ! ! -!FalseBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -name - ^'false' +!SAssignment methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assignees + ^assignees ! ! -!FalseBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! -value - ^false +!SAssignment methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +expression + ^expression ! ! -!NilBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -encodeUsing: aTreecodeEmitter - aTreecodeEmitter encodeNil +!SAssignment methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +expression: anSExpression + expression := anSExpression ! ! -!NilBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -name - ^'nil' +!SAssignment methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + assignees := OrderedCollection new ! ! -!NilBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! -value - ^nil +!SAssignment methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assign: anSIdentifier + assignees add: anSIdentifier ! ! -!TrueBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeUsing: aTreecodeEmitter - aTreecodeEmitter encodeTrue +!SAssignment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isAssignment + ^true ! ! -!TrueBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -name - ^'true' +!SAssignment methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream indent: anInteger + aStream tab: anInteger; nextPutAll: '{AssignmentId.'. + assignees + do: [:identifier | + aStream cr. + identifier printOn: aStream indent: anInteger + 1] + separatedBy: [aStream nextPutAll: '.']. + aStream nextPutAll: '.'; cr. + expression printOn: aStream indent: anInteger + 1. + aStream nextPutAll: '}' ! ! -!TrueBinding methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! -value - ^true +!SAssignment class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeAssignment ! ! -!LocalBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! -beInArray - environment := ArrayEnvironment new +!SAssignment class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +new + "return an initialized instance" + + ^ self basicNew initialize. + ! ! -!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -declaration - ^declaration +!SCascade methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitCascade: self ! ! -!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -declaration: anIdentifierNode - declaration := anIdentifierNode +!SCascade methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isCascade + ^true ! ! -!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -environment - ^environment index +!SCascade methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +messages + ^messages ! ! -!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentCaptureType - ^environment captureType +!SCascade methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +messages: aCollection + messages := aCollection ! ! -!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentIndex - ^environment index +!SCascade methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +receiver + ^receiver ! ! -!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentIndex: anInteger - environment index: anInteger +!SCascade methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +receiver: anSExpression + receiver := anSExpression ! ! -!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentObject - ^environment +!SCascade class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeCascade ! ! -!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -index - ^index +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitCascadeMessage: self ! ! -!LocalBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -index: aNumber - index := aNumber +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +argumentCount + ^arguments size ! ! -!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isInArray - ^self isInStack not +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +arguments + ^arguments ! ! -!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isInStack - ^environment isStack +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +arguments: aCollection + arguments := aCollection ! ! -!LocalBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isLocal - ^true +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cache: anSCompiledMethod when: type + cache ifNil: [ ^ cache := Array with: type with: anSCompiledMethod ]. + cache := cache , (Array with: type with: anSCompiledMethod) ! ! -!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! -beInlined - environment := InlinedArgEnvironment new +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cacheUndermessage: aBlockClosure + cache := aBlockClosure ! ! -!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! -description - ^'argument ' , name +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cachedUndermessage + ^ cache isBlock + ifTrue: [ cache ] ! ! -!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeUsing: aTreecodeEncoder - aTreecodeEncoder encodeArgument: index env: environment +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cascade + cascade ! ! -!ArgumentBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! -isInlined - ^environment isInlinedArgument +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cascade: anSCascade + cascade := anSCascade ! ! -!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -canBeAssigned - ^false +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +flushCache + cache := nil ! ! -!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -index: aNumber - index := aNumber. +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isCascadeMessage + ^true +! ! +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +methodFor: requiredType + | type | + cache ifNil: [ ^ nil ]. + 1 to: cache size by: 2 do: [ :i | + type := cache at: i. + type == requiredType + ifTrue: [ ^ cache at: i + 1 ] ]. + ^ nil ! ! -!ArgumentBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isArgument - ^true +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +receiver + ^cascade receiver ! ! -!ArgumentBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - environment := ArgumentEnvironment new +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +registerCacheWith: runtime + cache ifNil: [ runtime registerCache: self for: selector ] ! ! -!TemporaryBinding methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! -description - ^'temporary ' , name +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +selector + ^selector ! ! -!TemporaryBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeUsing: aTreecodeEncoder - aTreecodeEncoder encodeTemporary: index env: environment +!SCascadeMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +selector: aSymbol + selector := aSymbol ! ! -!TemporaryBinding methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - environment := StackEnvironment new +!SCascadeMessage class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeCascadeMessage ! ! -!TemporaryBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isTemporary - ^true +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitIdentifier: self ! ! -!SelfBinding methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:40'! -beReferencedFrom: aScriptNode - aScriptNode useSelf +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +binding: aBinding + binding := aBinding ! ! -!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -canBeAssigned - ^false +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isArgument + ^binding isArgument ! ! -!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeUsing: aTreecodeEmitter - aTreecodeEmitter encodeSelf +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isAssociation + ^binding isAssociation ! ! -!SelfBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isSelf +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isIdentifier ^true ! ! -!SelfBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -name - ^'self' +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isInstVar + ^binding isInstVar ! ! -!SuperBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -encodeUsing: aTreecodeEmitter - aTreecodeEmitter encodeSuper +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isLiteral + ^binding isLiteral ! ! -!SuperBinding methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -name - ^'super' +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isSelf + ^binding isSelf ! ! -!SuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isSelf - ^false +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isSelfOrSuper + ^binding isSelf or: [binding isSuper] ! ! -!SuperBinding methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! isSuper - ^true + ^binding isSuper ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -activate: aScriptNode while: aBlock - | current | - current := activeScript. - activeScript := aScriptNode. - aBlock value. - activeScript := current +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isTemporary + ^binding isTemporary ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -activeScope - ^activeScript scope +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isVariable + ^true ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -activeScript - ^activeScript +!SIdentifier methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream indent: anInteger + aStream + tab: anInteger; + nextPutAll: '{IdentifierId. '; + print: binding; + nextPutAll: '}' ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -activeScript: aParseNode - activeScript := aParseNode +!SIdentifier methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +binding + ^binding ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -ast - ^ast +!SIdentifier class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeIdentifier ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -frontend - ^frontend +!SLiteralVar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index + ^index ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -frontend: aCompiler - frontend := aCompiler +!SLiteralVar methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index: anInteger + index := anInteger ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -parser - ^SSmalltalkParser new compiler: self +!SLiteral methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitLiteral: self ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -result - ^result +!SLiteral methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isLiteral + ^true ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -scanner - ^SSmalltalkScanner new compiler: self +!SLiteral methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +value + ^value ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -sourceCode - ^source +!SLiteral methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +value: anObject + value := anObject ! ! -!SSmalltalkCompiler methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -sourceCode: aString - source := aString +!SLiteral methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream indent: anInteger + aStream + tab: anInteger; + nextPutAll: '{LiteralId. '; + print: value; + nextPutAll: '}' ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -assignmentNode - ^SAssignmentNode new compiler: self +!SLiteral class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeLiteral ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -blockNode - ^SBlockNode new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitMessage: self ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -braceNode - ^SBraceNode new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +arguments + ^arguments ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildMethod - result method: ast buildMethod +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +arguments: aCollection + arguments := aCollection ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -cascadeMessageNode - ^SCascadeMessageNode new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cache: anSCompiledMethod when: type + cache + ifNil: [ ^ cache := Array with: type with: + anSCompiledMethod]. + cache := cache + , + (Array with: type with: + anSCompiledMethod) ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -cascadeNode - ^SCascadeNode new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cacheUndermessage: aBlockClosure + cache := aBlockClosure ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -commentNode - ^SCommentNode new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +cachedUndermessage + ^cache isBlock ifTrue: [ cache ] ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -compileMethod: aString - source := aString. - frontend protect: [ - self - parseMethod; - resolveSemantics; - buildMethod]. - ^result +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +flushCache + cache := nil ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -delimiterToken - ^SDelimiterToken new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + super initialize. + arguments := #(). + inlined := false ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -endToken - ^SEndToken new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isInlined + ^ inlined ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasBlocks - ^ blocks > 0 +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isMessage + ^true ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasSends -^ leaf not +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +methodFor: requiredType + | type | + cache ifNil: [ ^ nil ]. + 1 to: cache size by: 2 do: [ :i | + type := cache at: i. + type == requiredType + ifTrue: [ ^ cache at: i + 1 ] ]. + ^ nil ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -identifierNode - ^SIdentifierNode new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream indent: anInteger + aStream tab: anInteger; nextPutAll: '{MessageId. '; print: selector; nextPutAll: '. '; cr. + receiver printOn: aStream indent: anInteger + 1. + aStream nextPutAll: '.'; cr. + arguments + do: [:statement | statement printOn: aStream indent: anInteger + 1] + separatedBy: [aStream nextPutAll: '. '; cr]. + aStream nextPutAll: '}' ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - self reset +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +receiver + ^receiver +! ! +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +receiver: anSExpression + receiver := anSExpression ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -literalNode - ^SLiteralNode new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +registerCacheWith: runtime + cache ifNil: [ runtime registerCache: self for: selector ] ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -messageNode - ^SMessageNode new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +selector + ^selector ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -methodNode - ^SMethodNode new compiler: self +!SMessage methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +selector: aSelector + selector := aSelector ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -noticeSend - leaf := false +!SMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +argumentCount + ^arguments size ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -numericLiteralNode - ^SNumberNode new compiler: self +!SMessage methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlined: aBoolean + inlined := aBoolean ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -pragmaNode - ^SPragmaNode new compiler: self +!SMessage class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeMessage ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -reset - self resetResult. - leaf := true. - blocks := 0. +!SMessage class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +new + "return an initialized instance" + + ^ self basicNew initialize. + ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -returnNode - ^SReturnNode new compiler: self +!SOpJump methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpJump: self ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -selectorNode - ^SSelectorNode new compiler: self +!SOpJump methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + aStream nextPutAll: self class name withArticle; nextPutAll: ' after '; print: target ! ! -!SSmalltalkCompiler methodsFor: 'nodes' stamp: 'KenD 28/Jun/2026 13:27:40'! -stringToken - ^SStringToken new compiler: self +!SOpJump methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +target + ^target ! ! -!SSmalltalkCompiler methodsFor: 'emitting' stamp: 'KenD 28/Jun/2026 13:27:40'! -blockCount - ^blocks +!SOpJump methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +target: anInteger + target := anInteger ! ! -!SSmalltalkCompiler methodsFor: 'emitting' stamp: 'KenD 28/Jun/2026 13:27:40'! -blockIndex - blocks := blocks + 1. - ^blocks - 1 +!SOpJumpFalse methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpJumpFalse: self ! ! -!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -compilationError: aString stretch: aStretch - ^SCompilationError new - compiler: self; - stretch: aStretch; - description: aString +!SOpJumpTrue methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpJumpTrue: self ! ! -!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -error: aString at: anInteger - | stretch | - stretch := anInteger thru: anInteger. - ^self error: aString stretch: stretch +!SOpLoadRfromFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpLoadRfromFrame: self ! ! -!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -error: aString stretch: aStretch - | error | - error := self compilationError: aString stretch: aStretch. - ^error beFatal; signal +!SOpLoadRfromFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index +^ index ! ! -!SSmalltalkCompiler methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -warning: aString at: aStretch - | error | - error := self compilationError: aString stretch: aStretch. - error beWarning; signal +!SOpLoadRfromFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index: anInteger + index := anInteger ! ! -!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -parseFragment - headless := false. - self reset. - ast := self parser methodFragment. - result ast: ast +!SOpPopR methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpPopR: self ! ! -!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -parseFragment: aString - source := aString. - [self parseFragment; resolveSemantics] on: SCompilationError do: []. - ^ast +!SOpStoreRintoFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpStoreRintoFrame: self ! ! -!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -parseMethod - headless := false. - self reset. - ast := self parser method. - result ast: ast +!SOpStoreRintoFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index + ^ index ! ! -!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -parseMethod: aString - source := aString. - frontend protect: [self parseMethod; resolveSemantics]. - ^result +!SOpStoreRintoFrame methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index: anInteger + index := anInteger ! ! -!SSmalltalkCompiler methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -resolveSemantics - ast acceptVisitor: SSemanticVisitor new +!SOpAssign methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpAssign: self ! ! -!SSmalltalkCompiler methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -resetResult - result := SCompilationResult new compiler: self +!SOpAssign methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assignees + ^assignees +! ! + +!SOpAssign methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assignees: aCollection + assignees := aCollection ! ! -!SSmalltalkCompiler methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -supportsBraceNodes - ^true +!SOpDispatchMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpDispatchMessage: self ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -addBodyTo: aMethodNode - self - addTemporariesTo: aMethodNode; - addPragmaTo: aMethodNode; - addStatementsTo: aMethodNode +!SOpDispatchMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +message + ^ message ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -addStatementsTo: aMethodNode - aMethodNode - position: token position; - addStatements: self statements; - end: token position; - moveCommentsFrom: token. - token isEnd - ifFalse: [^self unexpectedStatementError: aMethodNode statements] +!SOpDispatchMessage methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +message: anSMessage + message := anSMessage ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -addTemporariesTo: aMethodNode - aMethodNode temporaries: self temporaries +!SOpDropToS methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpDropToS: self ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -cascadeSequence: aMessageNode - | cascade receiver messages msg node | - (token is: $;) ifFalse: [^aMessageNode]. - cascade := self buildNode: compiler cascadeNode at: aMessageNode position. - receiver := aMessageNode receiver. - cascade receiver: receiver. - node := compiler cascadeMessageNode from: aMessageNode. - node cascade: cascade. - messages := OrderedCollection with: node. - [token is: $;] whileTrue: [ - self step. - msg := self buildCascadeMessageNode: receiver. - msg - cascade: cascade; - position: token position; - moveCommentsFrom: token. - messages add: msg. - self cascadeMessage: msg]. - ^cascade messages: messages asArray; end: msg end +!SOpDropToS methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +count + ^count ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -expression - | primary expression | - (token isNameToken and: [self peek isAssignment]) ifTrue: [^self assignment]. - primary := self primary ifNil: [^self missingExpression]. - expression := self unarySequence: primary. - expression := self binarySequence: expression. - expression := self keywordSequence: expression. - expression == primary - ifFalse: [expression := self cascadeSequence: expression]. - token endsExpression ifFalse: [self errorIn: primary]. - ^expression +!SOpDropToS methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +count: anInteger + count := anInteger ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -keywordSignature - | selector arguments node | - selector := '' writeStream. - arguments := OrderedCollection new. - node := self buildNode: compiler selectorNode at: token position. - [token isKeyword] whileTrue: [ - selector nextPutAll: token value. - node addKeyword: token asSelectorNode. - self step. - token isNameToken ifFalse: [self missingArgument]. - arguments add: token asIdentifierNode. - self step]. - arguments isEmpty ifTrue: [^nil]. - node - symbol: selector contents; - end: token end; - moveCommentsFrom: token. - ^self buildMethodNode: node arguments: arguments +!SOpLoadRfromStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpLoadRfromStack: self ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -methodPragma - self step. - ^[| method | - method := self methodSignature. - self addTemporariesTo: method; attachPragmaTo: method. - method pragma] - on: SCompilationError - do: [:ex | ex return: compiler pragmaNode] +!SOpLoadRfromStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index + ^index ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -methodSignature - self keywordSignature ifNotNil: [:m | ^m]. - self binarySignature ifNotNil: [:m | ^m]. - self unarySignature ifNotNil: [:m | ^m]. - self error: 'method signature expected' +!SOpLoadRfromStack methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index: anInteger + index := anInteger ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -parenthesizedExpression - | start open expression | - start := token position. - open := self step. - expression := self expression. - expression moveCommentsFrom: open. - (token is: $)) ifFalse: [self missingToken: ')']. - expression isImmediate - ifFalse: [expression position: start; end: token position]. - self step. - ^expression +!SOpLoadRwithNil methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpLoadRwithNil: self ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -primary - token isNameToken ifTrue: [^self step asIdentifierNode]. - token isLiteral ifTrue: [^self step]. - (token is: $[) ifTrue: [^self block]. - (token is: $() ifTrue: [^self parenthesizedExpression]. - (token is: #'#(') ifTrue: [^self literalArray]. - (token is: #'#[') ifTrue: [^self literalByteArray]. - (compiler supportsBraceNodes and: [token is: ${]) ifTrue: [^self bracedArray]. - (token is: #'-') ifTrue: [^self negativeNumber]. - (token is: #'<') ifTrue: [^self taggedNode]. - ^nil +!SOpLoadRwithSelf methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpLoadRwithSelf: self ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -return - | return expression end node | - return := self step. - expression := self expression. - expression moveCommentsFrom: token. - end := token position. - self skipDots. - node := self buildNode: compiler returnNode at: return position. - ^node - return: return; - end: end; - expression: expression; - moveCommentsFrom: return +!SOpPrimitive methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpPrimitive: self ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -statement - | expression | - ((token is: $^) or: [token is: $↑]) ifTrue: [^self return]. - expression := self expression. - token moveCommentsTo: expression. - ^expression +!SOpPrimitive methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +block + ^block ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -statements - | statements | - statements := OrderedCollection new. - [ - token endsExpression ifTrue: [^statements]. - statements add: self statement. - token is: $.] - whileTrue: [self skipDots]. - ^statements +!SOpPrimitive methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +block: aBlockClosure + block := aBlockClosure ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -step - | save comments | - save := token. - self next isComment ifFalse: [^save]. - comments := OrderedCollection new: 2. - [ - comments add: token. - self next isComment] whileTrue. - token comments: comments. - ^save +!SOpPushR methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpPushR: self ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -temporaries - | temporaries | - (token is: #'||') ifTrue: [ - self step. - ^#()]. - token isBar ifFalse: [^#()]. - temporaries := OrderedCollection new. - [ - self step. - token isNameToken] - whileTrue: [ - self validateLocalName: token. - temporaries add: token asIdentifierNode]. - token isBar ifFalse: [self missingToken: '|']. - self step. - ^temporaries +!SOpRestart methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpRestart: self ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -unaryMessage: aMessageNode - | selector | - selector := self unarySelector. - aMessageNode - selector: selector; - end: selector end; - arguments: #(); - moveCommentsFrom: selector +!SOpReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpReturn: self ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -unarySelector - | selector start end node | - selector := token value. - start := token position. - end := start + selector size - 1. - self step. - node := self buildNode: compiler selectorNode at: start. - ^node - symbol: selector; - end: end; - moveCommentsFrom: token +!SPragma methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name + ^ name ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -unarySequence: aParseNode - | node receiver | - node := aParseNode. - node isNameToken ifTrue: [node := node asIdentifierNode]. - [ - receiver := node. - self hasUnarySelector] - whileTrue: [ - node := self buildMessageNode: receiver. - self unaryMessage: node]. - ^node moveCommentsFrom: token +!SPragma methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name: aString + name := aString ! ! -!SSmalltalkParser methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -unarySignature - self hasUnarySelector ifFalse: [^nil]. - ^self buildMethodNode: self unarySelector arguments: #() +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitReturn: self ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -addByteTo: aCollection - | byte | - byte := token isLiteral ifTrue: [token value] ifFalse: [token literalValue]. - byte isInteger ifFalse: [self nonIntegerToken]. - (byte between: 0 and: 255) ifFalse: [self invalidByteValue]. - aCollection add: byte +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +expression + ^expression ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -assignment - | position variable delimiter expression assignment | - position := token position. - variable := self step asIdentifierNode moveCommentsFrom: token. - delimiter := self step. - expression := self expression. - expression isAssign - ifTrue: [^expression assign: variable operator: delimiter]. - expression moveCommentsFrom: token. - assignment := self buildNode: compiler assignmentNode at: position. - ^assignment assign: variable with: expression operator: delimiter +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +expression: anSExpression + expression := anSExpression ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -attachPragmaTo: aMethodNode - | start pragma | - (aMethodNode isHeadless orNot: [token is: #'<']) ifTrue: [^false]. - start := token position. - self step. - pragma := token isKeyword - ifTrue: [self ffiOrPrimitive: aMethodNode] - ifFalse: [self symbolicPragma]. - pragma position: start; end: token position. - aMethodNode pragma: pragma. - (token is: #'>') ifFalse: [self missingToken: '>']. +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isReturn ^true ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildBraceNode: elements at: position - | node | - node := self buildNode: compiler braceNode at: position. - ^node elements: elements +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +local + ^local ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildCascadeMessageNode: receiver - | node | - node := self buildNode: compiler cascadeMessageNode at: receiver position. - ^node receiver: receiver +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +local: aBoolean + local := aBoolean ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildMessageNode: receiver - | node | - node := self buildNode: compiler messageNode at: receiver position. - ^node receiver: receiver +!SReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream indent: anInteger + aStream tab: anInteger; nextPutAll: '{ReturnId.'; cr. + expression printOn: aStream indent: anInteger + 1. + aStream nextPutAll: '}' ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildMethodNode: selector arguments: arguments - | node | - node := self buildNode: compiler methodNode at: selector position. - compiler activeScript: node. - ^node selector: selector; arguments: arguments +!SReturn class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeReturn ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildNode: aParserNode at: anInteger - ^aParserNode position: anInteger; end: token position +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +argumentCount + ^compiledCode argumentCount ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildNode: aParseNode at: anInteger with: anObject - | node | - node := scanner buildToken: aParseNode at: anInteger with: anObject. - ^node end: token position +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +compiledCode + ^compiledCode ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -cascadeMessage: aMessageNode - | msg | - self hasUnarySelector ifTrue: [^self unaryMessage: aMessageNode]. - self hasBinarySelector ifTrue: [^self binaryMessage: aMessageNode]. - self hasKeywordSelector ifTrue: [^self keywordMessage: aMessageNode]. - msg := token value = '' - ifTrue: ['unfinished cascade'] - ifFalse: [token value asString , ' not allowed in cascade']. - self error: msg +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +compiledCode: anObject + compiledCode := anObject ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -ffiArguments - | args type | - args := OrderedCollection new. - self step. - token value !!= $( - ifTrue: [ self error: 'expected "("' ]. - self peek value = $) - ifTrue: [ self step. - ^ args ]. - [ type := self ffiType. - args add: type. - self step. - token value = #, ] whileTrue. - token value !!= $) - ifTrue: [ self error: 'expected ")"' ]. - ^ args +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + statements := #() ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -ffiCall: aBoolean method: aMethodNode - | cc return name args descriptor | - cc := token value. - return := self ffiType. - aBoolean - ifTrue: [ self step. - name := token value ifNil: [ self error: 'invalid function name' ] ]. - args := self ffiArguments. - args size = aMethodNode selector arity - ifFalse: - [ ^ self error: 'method arity does not match with function arguments' ]. - self step. - descriptor := SFFIDescriptor ret: return args: args cc: cc. - ^ compiler pragmaNode ffi: cc name: name with: descriptor +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream indent: anInteger + statements + do: [:statement | statement printOn: aStream indent: anInteger + 1] + separatedBy: [aStream nextPutAll: '.'; cr] ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -ffiOrPrimitive: aMethodNode - | tag | - tag := token value asLowercase. - tag last = $: ifFalse: [self invalidPragma]. - tag := tag allButLast. - token value: tag. - tag = 'primitive' ifTrue: [^self primitive]. - tag = 'callback' ifTrue: [ ^self ffiCall: false method: aMethodNode ]. - tag = 'callout' ifTrue: [ ^self ffiCall: true method: aMethodNode ]. - self invalidPragma +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +statements + ^statements ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -ffiType - | type | - self step. - token isNameToken ifFalse: [self error: 'expected type name']. - type := token value. - type = 'struct' ifFalse: [ ^type]. - self step. - token isNameToken ifFalse: [self error: 'expected type name']. - ^token value +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +statements: aCollection + statements := aCollection ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasKeywordSelector - ^token isKeyword +!SScript methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +tempCount + ^compiledCode tempCount ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasUnarySelector - ^token isNameToken +!SScript methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +optimizedCode: anObject + ^ self compiledCode optimizedCode: anObject ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -invalidPragma - | position stretch | - position := token position. - stretch := position thru: position. - ^SInvalidPragmaError new stretch: stretch; signal +!SScript class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +new + "return an initialized instance" + + ^ self basicNew initialize. + ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -keywordArgument - | arg | - arg := self primary ifNil: [self missingArgument]. - arg := self unarySequence: arg. - ^self binarySequence: arg +!SBlock methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitBlock: self ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -keywordMessage: aMessageNode - | selector arguments node | - node := self buildNode: compiler selectorNode at: token position. - selector := '' writeStream. - arguments := OrderedCollection new. - [token isKeyword] whileTrue: [ - selector nextPutAll: token value. - node addKeyword: self step. - arguments add: self keywordArgument]. - node symbol: selector contents; end: token prevPosition. - aMessageNode - arguments: arguments; - end: token prevPosition; - selector: node +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +capturedVariables + ^capturedVariables ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -keywordSequence: aParseNode - | expression | - self hasKeywordSelector ifFalse: [^aParseNode]. - expression := self buildMessageNode: aParseNode. - self keywordMessage: expression. - ^expression +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +capturedVariables: aCollection + capturedVariables := aCollection ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -literalKeyword - | keyword | - keyword := token value , scanner nextKeyword value. - ^keyword reduced asSymbol +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +capturesHome + ^compiledCode capturesHome ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -namedPrimitive - | name pragma | - token isNameToken - ifFalse: [ self invalidPragma ]. - name := token value. - pragma := self buildNode: compiler pragmaNode at: token position. - ^ pragma primitive: 0 name: name asSymbol +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index + ^index ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -negativeNumber - token := nil. - ^self negativeNumberOrBinary; step +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +index: anInteger + index := anInteger ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -numberedPrimitive - | number pragma | - number := token value. - number isInteger ifFalse: [self invalidPragma]. - pragma := self buildNode: compiler pragmaNode at: token position. - ^pragma primitive: number name: nil +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlinedArgs + ^ inlinedArgs ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -primitive - | primitive | - self step. - primitive := token isNumberNode - ifTrue: [self numberedPrimitive] - ifFalse: [self namedPrimitive]. - self step. - ^primitive +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlinedArgs: anArray + inlinedArgs:= anArray ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -pseudoLiteralValue - | value | - token isPoolLiteral ifTrue: [^token literalValue]. - value := token value. - value = 'nil' ifTrue: [^nil]. - value = 'true' ifTrue: [^true]. - value = 'false' ifTrue: [^false]. - ^token isPoolLiteral ifTrue: [token literalValue] ifFalse: [value asSymbol] +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +offsetOfCurrentEnvironment + ^ 2 ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -skipDots - [token is: $.] whileTrue: [self step] +!SBlock methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +optimizedCode + ^compiledCode optimizedCode ! ! -!SSmalltalkParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -validateLocalName: aSmalltalkToken - aSmalltalkToken isDelimitedIdentifier ifTrue: [^self]. - (aSmalltalkToken value includes: $.) - ifTrue: [self error: 'invalid embedded dot'] +!SBlock methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + capturedVariables := #() ! ! -!SSmalltalkParser methodsFor: 'api support' stamp: 'KenD 28/Jun/2026 13:27:40'! -addPragmaTo: aMethodNode - (self attachPragmaTo: aMethodNode) ifTrue: [self step] +!SBlock methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isBlock + ^true ! ! -!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! -arrayBody - | literals position | - literals := OrderedCollection new. - position := token position. - [ - self step. - (token is: $)) or: [token isEnd]] - whileFalse: [| element | - element := self arrayElement. - literals add: element]. - token isEnd ifTrue: [self missingToken: ')']. - ^self buildNode: compiler literalNode at: position with: literals asArray +!SBlock methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isInlined + ^ compiledCode isNil ! ! -!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! -arrayElement - token isLiteral ifTrue: [^token value]. - token isNameToken ifTrue: [^self pseudoLiteralValue]. - token isKeyword ifTrue: [^self literalKeyword]. - (token is: #'-') ifTrue: [^self negativeNumberOrBinary]. - token hasSymbol ifTrue: [^token value]. - (token is: $() ifTrue: [^self arrayBody value]. - (token is: #'#(') ifTrue: [^self arrayBody value]. - (token is: #'#[') ifTrue: [^self byteArrayBody value]. - self invalidArrayToken +!SBlock methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream indent: anInteger + aStream + tab: anInteger; + nextPutAll: '{BlockId. capturedVariables: '; + print: capturedVariables; + cr. + super printOn: aStream indent: anInteger. + aStream nextPutAll: '}' ! ! -!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! -braceBody - | elements position | - elements := OrderedCollection new. - position := token position. - self step. - [ - token isEnd ifTrue: [self missingToken: '}']. - token is: $}] - whileFalse: [ - elements add: self expression. - (token is: $.) ifTrue: [self step]]. - ^self buildBraceNode: elements at: position +!SBlock class methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeUsing: aTreecodeDecoder + ^aTreecodeDecoder decodeBlock ! ! -!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! -bracedArray - | array | - array := self braceBody. - self step. - ^array +!SMethod methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^visitor visitMethod: self ! ! -!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! -byteArrayBody - | bytes save start array node | - bytes := OrderedCollection new. - save := token. - start := token position. - [ - self step. - token isLiteral or: [token isPoolLiteral]] - whileTrue: [self addByteTo: bytes]. - (token is: $]) ifFalse: [ - token isNameToken - ifTrue: [self missingLiteral] - ifFalse: [self missingToken: ']']]. - array := ByteArray new: bytes size. - bytes withIndexDo: [:b :i | array at: i put: b]. - node := self buildNode: compiler literalNode at: start with: array. - ^node moveCommentsFrom: save +!SMethod methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isMethod + ^true ! ! -!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! -literalArray - | array | - array := self arrayBody. - self step. - ^array +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +offsetOfCurrentEnvironment + ^ 0 ! ! -!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! -literalByteArray - | node | - node := self byteArrayBody. - self step. - ^node +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +offsetOfEnvironment: anInteger + ^0 ! ! -!SSmalltalkParser methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:40'! -negativeNumberOrBinary - self peek isNumberNode - ifTrue: [token := self next negate position: token position - 1]. - ^token value +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +pragma + ^pragma ! ! -!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! -binaryMessage: aMessageNode - | selector primary argument | - selector := self step. - primary := self primary. - primary isNil ifTrue: [ - ((selector is: $:) and: [token is: #'=']) - ifTrue: [self - error: 'stray whitespaces left in assignment' - at: token position - 1] - ifFalse: [self error: 'primary missing']]. - argument := self unarySequence: primary. - aMessageNode - selector: selector asSelectorNode; - end: argument end; - arguments: {argument} +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +pragma: anSPragma + pragma := anSPragma +! ! + +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +primitive + ^pragma ifNotNil: [ pragma name ] ! ! -!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! -binarySequence: aParseNode - | node rcvr | - node := aParseNode. - [ - rcvr := node. - self hasBinarySelector] - whileTrue: [ - node := self buildMessageNode: rcvr. - self binaryMessage: node]. - ^node +!SMethod methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream indent: anInteger + aStream nextPutAll: '{MethodId. '; cr. + pragma ifNotNil: [ (pragma isKindOf: SExpression) ifTrue: [ pragma printOn: aStream indent: anInteger + 1] ifFalse: [ aStream tab: anInteger + 1; print: pragma ] ]. + super printOn: aStream indent: anInteger. + aStream nextPutAll: '}' ! ! -!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! -binarySignature +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +bindingTypeOf: id + ^ BindingTypes at: id +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeArgument + ^ SArgumentBinding new + index: self nextInteger; + environment: self nextEnvironment +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeAssignment + | assignment assignees | + assignment := SAssignment new. + + assignees := self nextExpressionArray. + assignment expression: self nextExpression. + assignees do: [ :identifier | assignment assign: identifier ]. + ^ assignment +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeBlock + + | expression inlined block index code | + expression := SBlock new. + inlined := self nextBoolean. + inlined + ifTrue: [ expression inlinedArgs: self nextArray ] + ifFalse: [ + index := self nextInteger. + block := self literalAt: index. + builder ifNotNil: [ + code := builder newExecutableCodeFor: expression. + builder blockExecutableCode: block put: code ]. + expression + compiledCode: block; + index: index; + capturedVariables: self nextArray ]. + expression statements: self nextExpressionArray. + ^ expression +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeCascade + | cascade receiver messages message count | + cascade := SCascade new. + receiver := self nextExpression. + count := self nextInteger. + messages := (1 to: count) + collect: [ :i | + message := SCascadeMessage decodeUsing: self. + message cascade: cascade ]. + ^ cascade + receiver: receiver; + messages: messages +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeCascadeMessage | selector arguments | - ((token isStringToken and: [token hasSymbol]) - or: [token is: $^] - or: [token is: $:]) - ifFalse: [^nil]. - selector := self step asSelectorNode. - token isNameToken ifFalse: [self missingArgument]. - self validateLocalName: token. - arguments := {token asIdentifierNode}. - self step. - token moveCommentsTo: selector. - ^self buildMethodNode: selector arguments: arguments + selector := self nextSymbol. + arguments := self nextExpressionArray. + ^ SCascadeMessage new + selector: selector; + arguments: arguments +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeDynamicVar + ^ SDynamicBinding new name: self nextSymbol +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeIdentifier + | type binding | + type := self bindingTypeOf: self nextInteger. + binding := type decodeUsing: self. + ^ SIdentifier new binding: binding +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeLiteral + | index value | + index := self nextInteger. + value := index = 0 + ifTrue: [ self nextLiteralInteger ] + ifFalse: [ self literalAt: index ]. + ^ SLiteral new + index: index; + value: value +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeMessage + | inlined selector receiver arguments | + inlined := self nextBoolean. + selector := self nextSymbol. + receiver := self nextExpression. + arguments := self nextExpressionArray. + ^ SMessage new + receiver: receiver; + selector: selector; + arguments: arguments; + inlined: inlined +! ! + +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeMethod + | type node next pragma | + type := stream next. + type !!= MethodId + ifTrue: [ self error: 'method treecode expected' ]. + node := SMethod new. + next := stream peek. + next = PragmaId + ifTrue: [ stream next. + pragma := SPragma new name: self nextSymbolOrNil. + node pragma: pragma ]. + node + compiledCode: method; + statements: self nextExpressionArray. + ^ node ! ! -!SSmalltalkParser methodsFor: 'binary' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasBinarySelector - ^(token isStringToken and: [token hasSymbol]) - or: [token is: $^] - or: [token is: $:] +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeNestedDynamicVar + ^ SNestedDynamicBinding new + name: + self nextSymbol. + ! ! -!SSmalltalkParser methodsFor: 'blocks' stamp: 'KenD 28/Jun/2026 13:27:40'! -block - | block | - block := self buildNode: compiler blockNode at: token position. - block parent: compiler activeScript. - compiler activate: block while: [ - token moveCommentsTo: block. - self step. - block - arguments: self blockArguments; - temporaries: self temporaries; - addStatements: self statements. - (token is: $]) ifFalse: [self missingToken: ']']. - block end: token position. - token moveCommentsTo: block. - self step]. - ^block +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeReturn + | expression local | + local := self nextBoolean. + expression := self nextExpression. + ^ SReturn new + local: local; + expression: expression ! ! -!SSmalltalkParser methodsFor: 'blocks' stamp: 'KenD 28/Jun/2026 13:27:40'! -blockArguments - | arguments | - (token is: $:) ifFalse: [^#()]. - arguments := OrderedCollection new. - [ - self step. - token isNameToken ifFalse: [self missingArgument]. - self validateLocalName: token. - arguments add: self step asIdentifierNode. - token is: $:] whileTrue. - token isBar ifTrue: [self step] ifFalse: [ - (token is: #'||') - ifTrue: [token value: #'|'] - ifFalse: [self missingToken: '|']]. - ^arguments +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +decodeTemporary + ^ STemporaryBinding new + index: self nextInteger; + environment: self nextEnvironment ! ! -!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -compiler - ^compiler +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nextArray + | count | + count := self nextInteger. + ^ stream next: count ! ! -!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -compiler: aSmalltalkCompiler - compiler := aSmalltalkCompiler. - scanner := compiler scanner +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nextEnvironment + | value | + value := self nextInteger. + ^ value !!= -2 + ifTrue: [ value ] ! ! -!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -next - token := next. - next := nil. - ^token ifNil: [token := scanner next] +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nextExpression + | type | + type := self nodeTypeOf: stream next. + ^type decodeUsing: self. + ! ! -!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -on: aString - scanner on: aString +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nextExpressionArray + | count | + count := self nextInteger. + ^(1 to: count) collect: [ :arg | self nextExpression ] ! ! -!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -peek - | comments | - next ifNotNil: [^next]. - next := scanner next. - next isComment ifFalse: [^next]. - comments := OrderedCollection new: 2. - [ - comments add: next. - next := scanner next. - next isComment] whileTrue. - ^next comments: comments +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nextSymbol + | index | + index := self nextInteger. + ^ self literalAt: index ! ! -!SSmalltalkParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -token - ^token +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nextSymbolOrNil + | index | + index := self nextInteger. + ^index !!= 0 ifTrue: [ self literalAt: index] ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -error: aString - self error: aString at: token position +!TreecodeDecoder methodsFor: 'public' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nodeTypeOf: id + ^NodeTypes at: id ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -error: aString at: position - ^compiler error: aString at: position +!TreecodeDecoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +builder: aRuntime + builder := aRuntime ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -invalidArrayToken - self error: 'invalid literal entry' +!TreecodeDecoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +method: aMethod + method := aMethod ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -invalidByteValue - self error: 'value not between 0 and 255' +!TreecodeDecoder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +stream: aStream + stream := aStream ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -missingArgument - self error: 'argument missing' +!TreecodeDecoder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +literalAt: anInteger + ^ builder ifNil: [method at: anInteger] ifNotNil: [builder method: method literalAt: anInteger] ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -missingExpression - self error: 'missing expression' +!TreecodeDecoder methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nextLiteralInteger + | value | + value := self nextInteger. + ^ builder + ifNil: [ value ] + ifNotNil: [ builder newInteger: value ] ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -missingLiteral - self error: 'missing literal or named literal' +!TreecodeDecoder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nextBoolean + ^ stream next = 1 ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -missingToken: aString - self error: 'missing ' , aString +!TreecodeDecoder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nextInteger + | value | + value := stream next. + value = 16r80 + ifTrue: [ ^ stream int64 ]. + ^ value <= 127 + ifTrue: [ value ] + ifFalse: [ value - 16r100 ] ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -nonIntegerToken - self error: 'non-integer token' +!TreecodeDecoder methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nextUnsignedInteger + | value | + value := self nextByte. + ^value < 128 + ifTrue: [value] + ifFalse: [value - 128 + (self nextUnsignedInteger bitShift: 7)] +! ! + +!TreecodeDecoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initializeBindingTypes + BindingTypes := Dictionary new. + BindingTypes + at: NilId put: SNilBinding; + at: TrueId put: STrueBinding; + at: FalseId put: SFalseBinding; + at: ArgumentId put: SArgumentBinding; + at: TemporaryId put: STemporaryBinding; + at: SelfId put: SSelfBinding; + at: SuperId put: SSuperBinding; + at: DynamicVarId put: SDynamicBinding; + at: NestedDynamicVarId put: SNestedDynamicBinding +! ! + +!TreecodeDecoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initializeNodeTypes + NodeTypes := Dictionary new. + NodeTypes + at: AssignmentId put: SAssignment; + at: BlockId put: SBlock; + at: CascadeId put: SCascade; + at: LiteralId put: SLiteral; + at: IdentifierId put: SIdentifier; + at: MessageId put: SMessage; + at: ReturnId put: SReturn +! ! + +!TreecodeDecoder class methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initializePools + "TODO: would be best to share this code with encoder. However, both can be loaded (or not) independently" + self addNamespaceAs: #BindingIds. + BindingIds + at: #NilId put: 1; + at: #TrueId put: 2; + at: #FalseId put: 3; + at: #ArgumentId put: 4; + at: #TemporaryId put: 5; + at: #SelfId put: 6; + at: #SuperId put: 7; + at: #DynamicVarId put: 14; + at: #NestedDynamicVarId put: 15; + at: #PushRid put: 50; + at: #PopRid put: 51. + + self addNamespaceAs: #TreecodeIds. + TreecodeIds + at: #MethodId put: 101; + at: #BlockId put: 102; + at: #IdentifierId put: 103; + at: #LiteralId put: 104; + at: #MessageId put: 105; + at: #CascadeId put: 106; + at: #BraceId put: 107; + at: #AssignmentId put: 108; + at: #ReturnId put: 109; + at: #PragmaId put: 110 + ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -notify: aString - compiler notify: aString at: token position +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +at: aString + ^merged at: aString ifAbsent: [nil] ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -notify: aString at: position - compiler notify: aString at: position +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +at: aString ifAbsent: aBlock + ^merged at: aString ifAbsent: aBlock ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -warning: aString - compiler warning: aString at: token position +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +dependencies + ^self at: 'dependencies' ifAbsent: [OrderedDictionary new] ! ! -!SSmalltalkParser methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -warning: aString at: position - compiler warning: aString at: position +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +modulePaths + | paths section | + paths := self at: 'paths'. + paths ifNil: [^#()]. + section := paths at: 'modules' ifAbsent: [nil]. + section ifNil: [^#()]. + ^section ! ! -!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! -headlessMethod - | method | - self step. - method := compiler methodNode. - compiler activeScript: method. - self addBodyTo: method. - ^method +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name + | section | + section := self at: 'project'. + section ifNil: [^nil]. + ^section at: 'name' ifAbsent: [nil] ! ! -!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! -method - | method | - self step. - method := self methodSignature. - method isNil ifTrue: [^nil]. - self addBodyTo: method. - ^method +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +project + ^project ! ! -!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! -methodFragment - | method | - self step. - method := self methodSignature. - method isNil ifTrue: [^nil]. - [self addBodyTo: method] on: SCompilationError do: []. - ^method +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +user + ^user ! ! -!SSmalltalkParser methodsFor: 'productions' stamp: 'KenD 28/Jun/2026 13:27:40'! -methodSelector - self step. - ^self methodSignature ifNotNil: [:m | m selectorNode] +!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +version + | section | + section := self at: 'project'. + section ifNil: [^nil]. + ^section at: 'version' ifAbsent: [nil] ! ! -!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -parse: aString - ^self on: aString; method +!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load + self loadUser. + self loadProject. + self merge ! ! -!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -parseExpression: aString - ^self on: aString; headlessMethod +!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadProject + | cwd path contents | + cwd := Kernel currentDirectory. + path := cwd, '/epm.toml'. + (Kernel pathExists: path) + ifTrue: [ + contents := Kernel readFile: path. + project := TOMLParser parse: contents] + ifFalse: [project := OrderedDictionary new] ! ! -!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -parseFragment: aString - | method | - self on: aString; step. - [ - method := self methodSignature. - method notNil ifTrue: [self addBodyTo: method]] - on: SCompilationError - do: []. - ^method +!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadUser + | home path contents | + home := Kernel getEnv: 'HOME'. + home ifNil: [user := OrderedDictionary new. ^self]. + path := home, '/.egg/config.toml'. + (Kernel pathExists: path) + ifTrue: [ + contents := Kernel readFile: path. + user := TOMLParser parse: contents] + ifFalse: [user := OrderedDictionary new] +! ! + +!Config methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +merge + merged := OrderedDictionary new. + self mergeFrom: user into: merged. + self mergeFrom: project into: merged +! ! + +!Config methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +mergeFrom: aSource into: aTarget + aSource keysAndValuesDo: [:k :v | + | existing | + existing := aTarget at: k ifAbsent: [nil]. + (v isKindOf: OrderedDictionary) + ifTrue: [ + (existing isKindOf: OrderedDictionary) + ifTrue: [self mergeFrom: v into: existing] + ifFalse: [ + | copy | + copy := OrderedDictionary new. + self mergeFrom: v into: copy. + aTarget at: k put: copy]] + ifFalse: [aTarget at: k put: v]] ! ! -!SSmalltalkParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:40'! -parseTemporaries: aString - self on: aString; step. - ^self methodSignature notNil ifTrue: [self temporaries] +!Config class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +load + ^self new load ! ! -!SSmalltalkParser methodsFor: 'ffi support' stamp: 'KenD 28/Jun/2026 13:27:40'! -symbolicPragma - | position symbol pragma | - position := token position. - symbol := self step value. - pragma := self buildNode: compiler pragmaNode at: position. - ^pragma symbol: symbol +!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +dir: aString + dir := aString ! ! -!SSmalltalkParser class methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:40'! -parseSelector: aString - | cmp parser | - cmp := SCompiler new. - parser := self new compiler: cmp smalltalkCompiler; on: aString. - ^parser methodSelector ifNotNil: [:n | n value] +!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +moduleName + | first | + first := name first asUppercase. + ^(String with: first), (name copyFrom: 2) ! ! -!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildToken: aSmalltalkToken - ^self buildToken: aSmalltalkToken at: stream position +!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +name: aString + name := aString ! ! -!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildToken: aSmalltalkToken at: anInteger - | string | - string := stream copyFrom: anInteger to: stream position. - ^self buildToken: aSmalltalkToken at: anInteger with: string +!ProjectGenerator methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +ensureDir + dir ifNil: [ + dir := Kernel currentDirectory, '/', name]. + Kernel createDirectory: dir ! ! -!SSmalltalkScanner methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildToken: aSmalltalkToken at: anInteger with: anObject - ^aSmalltalkToken - position: anInteger; - value: anObject; - end: stream position +!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +generate + | modules module | + self ensureDir. + modules := dir, '/modules'. + module := modules, '/', self moduleName. + Kernel createDirectory: modules. + Kernel createDirectory: module. + self generateToml. + self generateModule: module ! ! -!SSmalltalkScanner methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -canBeInIdentifier: aCharacter - ^compiler frontend canBeInIdentifier: aCharacter -! ! +!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +generateModule: aString + | filename contents module | + module := self moduleName. + filename := aString, '/', module, 'Module.st'. + contents := '" + See (MIT) license in root directory. +" -!SSmalltalkScanner methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -canStartIdentifier: aCharacter - (compiler frontend canStartIdentifier: aCharacter) ifFalse: [^false]. - aCharacter = $_ - ifTrue: [^stream peek ifNil: [false] ifNotNil: [:ch | ch asInteger >= 33]]. - ^true -! ! +Class { + #name : #', module, 'Module, + #superclass : #Module, + #instVars : [], + #category : #', module, ' +} -!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -compiler - ^compiler +{ #category : #main } +', module, 'Module >> main: args [ + Kernel log: ''Hello from ', name, ''' +] +'. + Kernel writeFile: filename contents: contents ! ! -!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -compiler: aSmalltalkCompiler - compiler := aSmalltalkCompiler. - compiler sourceCode ifNotNil: [:s | self sourceCode: s] -! ! +!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +generateToml + | filename contents | + self ensureDir. + filename := dir, '/epm.toml'. + contents := '[project] +name = "', name, '" +version = "0.1.0" +description = "" -!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -on: aString - stream := aString readStream. - compiler notNil ifTrue: [compiler sourceCode: aString] +[dependencies] +'. + Kernel writeFile: filename contents: contents ! ! -!SSmalltalkScanner methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -sourceCode: aString - stream := aString readStream +!Builder methodsFor: 'degugging' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +activateDebugMode + closure activateDebugMode ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -end - ^self buildToken: compiler endToken at: stream position + 1 +!Builder methodsFor: 'closure' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addBoundary: anObject as: aSymbolicReference + closure addBoundary: anObject as: aSymbolicReference ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -isBinary: aCharacter - | code | - aCharacter isNil ifTrue: [^false]. - code := aCharacter asInteger. - code < 128 ifTrue: [ - ^#($+ $- $< $> $= $* $/ $\ $| $& $~ $, $@ $% $? $!! $: $^) - includes: aCharacter]. - ^code > 255 +!Builder methodsFor: 'closure' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addNilToken + closure analyze: closure nilToken from: HashTable nilToken ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -next - ^self nextToken +!Builder methodsFor: 'closure' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +build + | metaclasses | + classes := module classes. + classes do: [:c | self mapClass: c]. + module prepareForSnapshot: self. + metaclasses := classes collect: [:c | c class]. + closure scope: classes , metaclasses; traverse: module. ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextArrayPrefix - | string | - string := stream copyFrom: stream position - 1 to: stream position. - ^self - buildToken: compiler delimiterToken - at: stream position - 1 - with: string +!Builder methodsFor: 'closure' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +importNilToken + closure addBoundary: closure nilToken as: SymbolicReference nilToken ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextAssignment - ^self buildToken: compiler delimiterToken at: stream position with: #':=' +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +closure + ^closure ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextBinarySelector - stream back. - ^self - buildToken: compiler stringToken - at: stream position + 1 - with: self scanBinarySymbol +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +imports + ^closure boundary ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextBinarySymbol - ^self - buildToken: compiler literalNode - at: stream position - with: self scanBinarySymbol +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +map: anObject to: anotherObject + closure map: anObject to: anotherObject ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextColon - | start char | - start := stream position. - char := stream peek. - ((char = Character space or: [char = Character tab]) and: [(stream peek: 2) second = $=]) ifTrue: [ - stream skip: 1. - char := $=]. - char = $= ifTrue: [ - stream skip. - ^self nextAssignment position: start]. - ^(self isBinary: stream peek) - ifTrue: [self nextBinarySelector] - ifFalse: [self nextSpecialCharacter] - +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +mapping + ^closure mapping ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextComment - | start comment | - start := stream position. - [ stream atEnd not and:[stream peek !!== $"] ] whileTrue: [stream next]. - stream atEnd ifTrue: [self error: 'unfinished comment' at: start]. - stream position: start. - comment := stream upTo: $". - ^self buildToken: compiler commentNode at: start with: comment - +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +module + ^module ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextIdentifierOrKeyword - | start | - start := stream position. - self skipIdentifier. - ((stream peekFor: $:) and: [stream peekFor: $=]) ifTrue: [stream skip: -2]. - ^self buildToken: compiler stringToken at: start +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +module: aModule + module := aModule. ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextKeyword - | start string | - start := stream position + 1. - self skipKeyword. - string := stream copyFrom: start to: stream position. - ^self buildToken: compiler literalNode at: start - 1 with: string asSymbol +!Builder methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +objects + ^closure objects ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextLiteralCharacter - stream atEnd ifTrue: [^self error: 'character expected']. - ^self - buildToken: compiler literalNode - at: stream position - with: stream next +!Builder methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +mapClass: aClass + self + mapSubclassesOf: aClass; + mapMethodsOf: aClass; + mapMethodsOf: aClass class ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextLiteralString - ^self - buildToken: compiler literalNode - at: stream position - with: self scanString reduced +!Builder methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +mapMethod: method + | copy | + copy := method copy. + closure map: method to: copy. + method hasBlocks ifFalse: [^self]. + method withIndexDo: [:b :i | | bcopy | + b isBlock ifTrue: [ + bcopy := copy at: i. + closure map: b to: bcopy]] +! ! + +!Builder methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +mapMethodsOf: aClass + | original saved | + original := aClass methodDictionary. + saved := original collect: [:method | module originalMethodFor: method]. + saved := saved select: [:method | method notNil]. + saved do: [:method | self mapMethod: method]. + closure map: original to: saved +! ! + +!Builder methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +mapSubclassesOf: aClass + | original saved | + original := aClass subclasses. + saved := original select: [:s | module classes includes: s]. + closure map: original to: saved +! ! + +!Builder methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + closure := ObjectClosure new builder: self +! ! + +!ObjectClosure methodsFor: 'closure' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addSlotsOf: anObject + self analyze: anObject behavior from: anObject. + 1 to: anObject _pointersSize do: [ :i | | slot | + slot := anObject _basicAt: i. + self analyze: slot from: anObject] +! ! + +!ObjectClosure methodsFor: 'closure' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +analyze: anObject from: source + | surrogate | + surrogate := self surrogateFor: anObject. + (boundary includesKey: surrogate) ifTrue: [^self]. + (added includes: surrogate) ifTrue: [^self]. + (surrogate shouldBeStoredIn: self) ifFalse: [^self addBoundary: surrogate]. + self isDebugging ifTrue: [reversePaths at: anObject put: source]. + added add: surrogate. + objects add: surrogate. + queue add: surrogate. +! ! + +!ObjectClosure methodsFor: 'closure' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +traverse: anObject + | obj | + queue add: anObject. + [ queue isEmpty ] + whileFalse: [ + obj := queue removeFirst. + self addSlotsOf: obj ] ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextNumber - | parser assoc | - stream skip: -1. - parser := NumberParser new on: stream. - assoc := parser next. - parser error ifNotNil: [:e | ^self error: e key at: e value]. - ^self - buildToken: compiler numericLiteralNode - at: assoc value start - with: assoc key +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addBoundary: anObject + self addBoundary: anObject as: anObject asSymbolicReference ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextQuotedSymbol - | node | - node := self nextLiteralString. - ^node beSymbol; position: node position - 1 +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addBoundary: anObject as: aSymbolicReference + boundary at: anObject put: aSymbolicReference ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextSpecialCharacter - | token | - token := self buildToken: compiler delimiterToken. - ^token beCharacter +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +boundary + ^boundary ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextSymbolOrArrayPrefix - | char | - stream atEnd ifTrue: [self error: 'character expected']. - char := stream peek. - (self canBeInIdentifier: char) ifTrue: [^self nextKeyword]. - (self isBinary: char) ifTrue: [^self nextBinarySymbol]. - stream next. - (char = $[ or: [char = $(]) ifTrue: [^self nextArrayPrefix]. - char = $' ifTrue: [^self nextQuotedSymbol]. - self error: 'character expected' +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +builder + ^builder ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -nextToken - | first | - first := self scanChar. - first isNil ifTrue: [^self end]. - (self canStartIdentifier: first) ifTrue: [^self nextIdentifierOrKeyword]. - (first = $→ or: [first = $_]) ifTrue: [^self nextAssignment]. - first = $: ifTrue: [^self nextColon]. - first = $' ifTrue: [^self nextLiteralString]. - first = $$ ifTrue: [^self nextLiteralCharacter]. - first = $# ifTrue: [^self nextSymbolOrArrayPrefix]. - first = $" ifTrue: [^self nextComment]. - first isDigit ifTrue: [^self nextNumber]. - (first !!= $^ and: [first !!= $↑ and: [self isBinary: first]]) - ifTrue: [^self nextBinarySelector]. - ^self nextSpecialCharacter +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +builder: aBuilder + builder := aBuilder ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -scanBinarySymbol - | start symbol | - start := stream position. - self skipBinary. - symbol := stream copyFrom: start + 1 to: stream position. - ^symbol asSymbol +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +mapping + ^mapping ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -scanChar - ^(stream skipSeparators; atEnd) ifFalse: [stream next] - +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +module + ^builder module ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -scanString - | current start | - start := current := stream position. - ^String streamContents: [:writer | - [| fragment | - fragment := stream upTo: $'. - writer nextPutAll: fragment. - (current < stream position and: [(stream back; next) = $']) - ifFalse: [self error: 'string end expected' at: start]. - stream peekFor: $'] - whileTrue: [ - writer nextPut: $'. - current := stream position]] +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nilToken + ^nilToken ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -skipBinary - [self isBinary: stream peek] whileTrue: [stream next] +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +roots: aCollection + roots := aCollection ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -skipIdentifier - | frontend | - frontend := compiler frontend. - [stream atEnd] - whileFalse: [(frontend peekForIdentifier: stream) ifFalse: [^self]] +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +scope + ^scope ! ! -!SSmalltalkScanner methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:40'! -skipKeyword - | frontend continue pos | - frontend := compiler frontend. - [ - self skipIdentifier. - continue := false. - (stream peekFor: $:) ifTrue: [ - pos := stream position. - stream atEnd - ifFalse: [continue := frontend canStartIdentifier: stream peek]]. - continue] whileTrue. - pos isNil ifFalse: [stream position: pos] +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +scope: classes + scope addAll: classes ! ! -!SSmalltalkScanner methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -error: aString - ^self error: aString at: stream position +!ObjectClosure methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +surrogateFor: anObject + anObject == HashTable nilToken ifTrue: [^nilToken]. + ^mapping at: anObject ifAbsent: [anObject] ! ! -!SSmalltalkScanner methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:40'! -error: aString at: anInteger - ^compiler error: aString at: anInteger +!ObjectClosure methodsFor: 'degugging' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +activateDebugMode + debug := true. + reversePaths := IdentityDictionary new: 100. ! ! -!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! -comment - ^comments notNil ifTrue: [comments anyOne] +!ObjectClosure methodsFor: 'degugging' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +isDebugging + ^debug ! ! -!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! -comments - ^comments +!ObjectClosure methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + mapping := IdentityDictionary new. + queue := OrderedCollection new: 2000. + added := IdentitySet new: 2000. + objects := OrderedCollection new: 2000. + boundary := IdentityDictionary new: 100. + nilToken := Object new. + scope := Set new. + debug := false. ! ! -!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! -comments: aCollection - aCollection isNil ifTrue: [^self]. - comments isNil - ifTrue: [comments := aCollection] - ifFalse: [comments addAll: aCollection] +!ObjectClosure methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +map: anObject to: anotherObject + mapping at: anObject put: anotherObject ! ! -!SToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:40'! -moveCommentsTo: aParseNode - aParseNode comments: comments. - comments := nil +!ObjectClosure methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +objects + ^objects ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -compileWarning: aString - compiler notify: aString at: self stretch +!ObjectClosure methodsFor: 'debugging' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +reversePathOf: anObject + | path current | + path := OrderedCollection new. + current:= anObject. + [ + path add: current. + current := reversePaths at: current ifAbsent: [^path]. + ] repeat ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -compiler - ^compiler +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationClass + ^associationClass ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -compiler: aSmalltalkCompiler - compiler := aSmalltalkCompiler +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bucketOfSize: anInteger + | bucket | + bucket := (bucketClass new: anInteger) policy: self. + weak ifTrue: [bucket beWeak]. + ^bucket ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -end - ^stretch end +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +equates: key with: anObject + | item | + item := storesAssociations ifTrue: [anObject key] ifFalse: [anObject]. + ^comparison isNil + ifTrue: [key = item] + ifFalse: [comparison evaluateWith: key with: item] ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -end: aNumber - stretch end: aNumber +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hashFor: anObject + ^hasher notNil + ifTrue: [hasher evaluateWith: anObject] + ifFalse: [anObject hash] ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -position - ^stretch start +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keyFor: anObject + ^storesAssociations ifTrue: [anObject key] ifFalse: [anObject] ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -position: aNumber - stretch start: aNumber +!HashTablePolicy methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +useWeakSlots + weak := true ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -prevPosition - ^stretch start - 1 +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationClass: aClass + associationClass := aClass ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -source - ^compiler sourceCode copyFrom: stretch start to: stretch end +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bucketClass: aClass + bucketClass := aClass ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -stretch - ^stretch +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +comparison: evaluableObject + comparison := evaluableObject ! ! -!SToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -stretch: aStretch - stretch := aStretch +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +emptySlot + ^weak ifTrue: [EmptySlot] ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -endsExpression - ^self isEnd +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hasher: evaluableObject + hasher := evaluableObject ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasSymbol - ^false +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +maxSlots + ^maxSlots ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -is: anObject - ^false +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +maxSlots: anInteger + maxSlots := anInteger ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isAssignment - ^false +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +storesAssociations: aBoolean + storesAssociations := aBoolean ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isBar - ^(self is: #'|') or: [self is: #'/'] +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +useIdentityHash + self + hasher: [:key | key basicHash * 16273]; + comparison: [:a :b | a == b] ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isBlockNode - ^false +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +useStringHash + self + hasher: [:key | key stringHash]; + comparison: [:a :b | a equals: b] ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isComment - ^false +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +usesWeakSlots + ^weak ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isDelimiter - ^false +!HashTablePolicy methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +weak: aBoolean + weak := aBoolean ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isEnd - ^false +!HashTablePolicy methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +contentOfSize: anInteger + | table | + table := bucketClass new: anInteger. + table policy: self. + weak ifTrue: [table beWeak]. + ^table ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isIdentifier - ^false +!HashTablePolicy methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initialize + associationClass := Association. + weak := storesAssociations := false ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isKeyword - ^false +!HashTablePolicy class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +emptySlot + ^EmptySlot ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isLiteral - ^false +!HashTablePolicy class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initializeEmptySlot + EmptySlot := Object new ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isNameToken - ^false +!ImageSegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +name + ^name ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isNumberNode - ^false +!ImageSegment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +name: aString + name := aString ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isPoolLiteral - ^false +!ImageSegment class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +load: filename + "TO BE IMPLEMENTED!!" + ^nil ! ! -!SToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isStringToken - ^false +!LMRObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +size + ^self primitiveSize ! ! -!SToken methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - stretch := 1 thru: 0 +!MatchAlgorithm methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +failBecause: aString + failure := aString ! ! -!SToken methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -isDelimitedIdentifier - ^false +!MatchAlgorithm methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +reset + | end | + failure := nil. + tokens := pattern tokens. + string start: start. + end := stop notNil ifTrue: [stop] ifFalse: [string string size]. + string stop: end. + ranges := OrderedCollection new: tokens size ! ! -!SEndToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isEnd - ^true +!MatchAlgorithm methodsFor: 'outputs' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +failure + ^failure ! ! -!SEndToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -position: aNumber - super position: aNumber - 1 +!MatchAlgorithm methodsFor: 'outputs' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hasMatched + ^failure isNil and: [tokens isEmpty] ! ! -!SEndToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -prevPosition - ^stretch start +!MatchAlgorithm methodsFor: 'outputs' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchRange + | sorted | + sorted := ranges collect: #value thenSelect: [:p | p x <= p y]. + sorted := sorted asSortedCollection: [:p :q | p x < q x]. + ^sorted notEmpty ifTrue: [sorted first x @ sorted last y] ! ! -!SEndToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! -value: aString - '' +!MatchAlgorithm methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hasTokens + ^failure isNil and: [tokens notEmpty] ! ! -!SParseNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:41'! -acceptVisitor: visitor - ^visitor visitParseNode: self +!MatchAlgorithm methodsFor: 'inputs' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +index: anInteger + start := anInteger ! ! -!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! -allNodesDo: aBlock - self nodesDo: aBlock includingDeclarations: true +!MatchAlgorithm methodsFor: 'inputs' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +pattern: aStringPattern + pattern := aStringPattern ! ! -!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! -nodeWithLiteral: anObject - ^self nodesDetect: [:n | (n isLiteral or: [n isSelector]) and: [n value = anObject]] ifAbsent: nil +!MatchAlgorithm methodsFor: 'inputs' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +string: aString + string := MatchToken on: aString from: 1 to: aString size +! ! +!MatchAlgorithm methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initialize + super initialize. + start := 1 ! ! -!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! -nodesDetect: aBlock ifAbsent: absentBlock - self nodesDo: [:node | (aBlock value: node) ifTrue: [ ^node ] ] includingDeclarations: false. - ^absentBlock value +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchFirstStar + | range | + range := string start @ nil. + ranges add: tokens first -> range. + tokens removeFirst. + self hasTokens + ifTrue: [tokens first matchFirstAfterStartOn: self] + ifFalse: [ + range y: string stop. + string stop: string start - 1] ! ! -!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! -nodesDo: aBlock - self nodesDo: aBlock includingDeclarations: false +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchFirstToken + | token min match save | + token := tokens first. + min := token length. + match := false. + save := string start. + [ + string length >= min and: [ + match := string beginsWith: token. + match not]] + whileTrue: [string start: string start + 1]. + match + ifTrue: [ + ranges add: token -> (string start @ (string start + min - 1)). + string start: string start + token length. + tokens removeFirst] + ifFalse: [ + tokens size = 1 ifTrue: [ + string start: save. + ^self privateMatchLastToken]. + self + failBecause: token asString , ' not present at position ' + , string start printString] ! ! -!SParseNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! -nodesDo: aBlock includingDeclarations: aBoolean - aBlock value: self +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchFirstTokenAfterStar + | token i | + token := tokens first. + i := string indexOf: token. + i = 0 + ifTrue: [ + self + failBecause: token asString , ' not present in inteval [' + , string start printString + , ', ' + , string stop printString] + ifFalse: [ + ranges last value y: i - 1. + ranges add: token -> (i @ (i + token length - 1)). + string start: i + token length. + tokens removeFirst] ! ! -!SParseNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -ast - ^compiler ast +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchLastToken + tokens size = 1 + ifTrue: [self matchFirstToken] + ifFalse: [self privateMatchLastToken] ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -hasAssign - ^false +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchNextToken + tokens first matchFirstOn: self ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isAssign - ^false +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +privateMatchLastToken + | token min match | + token := tokens last. + min := token length. + match := false. + [ + string length >= min and: [ + match := string endsWith: token. + match not]] + whileTrue: [string stop: string stop - 1]. + match + ifTrue: [ + ranges add: token -> (string stop - min + 1 @ string stop). + string stop: string stop - token length. + tokens removeLast] + ifFalse: [ + self + failBecause: token asString , ' not present at position ' + , (string stop - token length + 1) printString] ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isBraceNode - ^false +!MatchAlgorithm methodsFor: 'computing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +run + self reset. + tokens isEmpty ifTrue: [^self]. + tokens last matchLastOn: self. + [self hasTokens] whileTrue: [self matchNextToken] ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isCascade - ^false +!MatchToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +asString + ^string copyFrom: start to: stop ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isCascadeMessage - ^false +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: i + ^string at: i ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isEvaluable - ^false +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +length + ^stop - start + 1 ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isImmediate - ^false +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +start + ^start ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isMessageNode - ^false +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +start: anInteger + start := anInteger ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isMethod - ^false +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +stop + ^stop ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isMethodArgument - ^false +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +stop: anInteger + stop := anInteger ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isMethodTemporary - ^false +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +string + ^string ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isReturn - ^false +!MatchToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +string: aString + string := aString ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isSelector - ^false +!MatchToken methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +beginsWith: aMatchToken + self length >= aMatchToken length ifFalse: [^false]. + aMatchToken start to: aMatchToken stop do: [:i | | char | + char := aMatchToken at: i. + ((self at: start + i - 1) = char or: [char isQuestionMark]) ifFalse: [^false]]. + ^true ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isSelf - ^false +!MatchToken methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +endsWith: aMatchToken + | end | + self length >= aMatchToken length ifFalse: [^false]. + end := aMatchToken stop. + end to: aMatchToken start by: -1 do: [:i | | char | + char := aMatchToken at: i. + ((self at: stop - end + i) = char or: [char isQuestionMark]) ifFalse: [^false]]. + ^true ! ! -!SParseNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isSuper - ^false +!MatchToken methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexOf: aMatchToken + ^string indexOfString: aMatchToken asString from: start to: stop ! ! -!SParseNode methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:41'! -moveCommentsFrom: aParseNode - aParseNode moveCommentsTo: self +!MatchToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchFirstAfterStartOn: aMatchAlgorithm + aMatchAlgorithm matchFirstTokenAfterStar ! ! -!SParseNode methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:41'! -variableNamed: aString - self - allNodesDo: [:node | (node isIdentifier and: [node name = aString]) - ifTrue: [^node]]. - ^nil +!MatchToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchFirstOn: aMatchAlgorithm + aMatchAlgorithm matchFirstToken ! ! -!SAssignmentNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -acceptVisitor: visitor - ^visitor visitAssignment: self +!MatchToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchLastOn: aMatchAlgorithm + aMatchAlgorithm matchLastToken ! ! -!SAssignmentNode methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:40'! -assign: anIdentifierNode operator: aDelimiterToken - assignees add: anIdentifierNode. - operators add: aDelimiterToken +!MatchToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +printOn: aStream + start to: stop do: [:i | aStream nextPut: (string at: i)] ! ! -!SAssignmentNode methodsFor: 'adding / removing' stamp: 'KenD 28/Jun/2026 13:27:40'! -assign: anIdentifierNode with: aParseNode operator: aDelimiterToken - assignees add: anIdentifierNode. - operators add: aDelimiterToken. - expression := aParseNode +!MatchToken class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +on: aString from: start to: stop + ^self new + string: aString; + start: start; + stop: stop ! ! -!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -assignees - ^assignees +!Module methodsFor: 'snapshotting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +prepareForSnapshot: aBuilder + aBuilder + importNilToken; + addBoundary: Symbol symbolTable as: SymbolicReference symbolTable; + map: overriden to: Dictionary new ! ! -!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -expression - ^expression +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +addClass: aClass + classes add: aClass. + self exportClass: aClass ! ! -!SAssignmentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -operators - ^operators +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +addExtension: aCompiledMethod + | collection | + collection := extensions at: aCompiledMethod classBinding symbol ifAbsentPut: [OrderedCollection new]. + collection add: aCompiledMethod. ! ! -!SAssignmentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasAssign - ^true +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +addOverride: aCompiledMethod + overriden at: aCompiledMethod signature put: aCompiledMethod ! ! -!SAssignmentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isAssign - ^true +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bind + classes + reject: [:c | classes includes: c superclass] + thenDo: [:c | c superclass addSubclass: c]. + extensions keysAndValuesDo: [:s :methods | | meta key target | + meta := s endsWith: ' class'. + key := meta ifTrue: [(s trimTail: ' class') asSymbol] ifFalse: [s]. + target := namespace at: key ifAbsent: [self _halt]. + meta ifTrue: [target := target class]. + methods do: [:m | | current extension | + current := target compiledMethodAt: m selector. + extension := m asExtensionFor: self. + target addSelector: m selector withMethod: extension. + current notNil ifTrue: [current module addOverride: current]] + ] ! ! -!SAssignmentNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - assignees := OrderedCollection new: 1. - operators := OrderedCollection new: 1 +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bind: anObject as: aSymbol + namespace at: aSymbol put: anObject. + self justDefined: aSymbol ! ! -!SAssignmentNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! -nodesDo: aBlock includingDeclarations: aBoolean - super nodesDo: aBlock includingDeclarations: aBoolean. - assignees do: [:v | v nodesDo: aBlock includingDeclarations: aBoolean]. - expression nodesDo: aBlock includingDeclarations: aBoolean +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bindKernelExports + | bindings | + bindings := Dictionary new. + { + Object. Class. Metaclass. CompiledMethod. + Array. OrderedCollection. Set. Dictionary. + SmallInteger. String. Character. + } do: [:class | + bindings at: class symbol put: class]. + bindings at: #Kernel put: Kernel. + self bindAll: bindings ! ! -!SBraceNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -acceptVisitor: visitor - ^visitor visitBraceNode: self +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +export: anObject as: aSymbol + namespace at: aSymbol put: anObject. + exports add: aSymbol ! ! -!SBraceNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -asMessageNode - message notNil ifTrue: [^message]. - ^message := self expanded +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +exportClass: aClass + self export: aClass as: aClass name asSymbol ! ! -!SBraceNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isBraceNode - ^true +!Module methodsFor: 'services' stamp: 'KenD 1/Jul/2026, 7:36:13 pm (UTC)'! +exports + | result | + result := Dictionary new. + result at: '__module__' put: self. + exports do: [:aName | | value | + value := namespace at: aName. + result at: aName put: value]. + ^result ! ! -!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -elements - ^elements +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +import: moduleName + | module | + namespace at: moduleName ifPresent: [:loaded | ^loaded]. + module := Kernel load: moduleName. + self bind: module as: moduleName. + ^module ! ! -!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -elements: aCollection - elements := aCollection asArray +!Module methodsFor: 'services' stamp: 'KenD 1/Jul/2026, 7:37:00 pm (UTC)'! +import: aName from: moduleName + ^self import: aName from: moduleName as: aName ! ! -!SBraceNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -expanded - | receiver n new argument array messages i you yourself cascade | - receiver := compiler identifierNode name: 'Array'. - n := elements size. - new := compiler selectorNode symbol: #new:. - argument := compiler numericLiteralNode value: n. - array := compiler messageNode. - array receiver: receiver. - array selector: new. - array arguments: (Array with: argument). - i := 0. - messages := elements collect: [:elem | | msg sel idx args | - i := i + 1. - msg := compiler cascadeMessageNode position: elem position; end: elem end. - sel := compiler selectorNode symbol: #at:put:. - idx := compiler numericLiteralNode value: i. - args := Array with: idx with: elem. - msg selector: sel; arguments: args]. - you := compiler selectorNode symbol: #yourself. - yourself := compiler cascadeMessageNode. - yourself selector: you. - yourself arguments: #(). - messages := messages copyWith: yourself. - cascade := compiler cascadeNode receiver: array. - messages do: [:msg | msg cascade: cascade]. - ^cascade messages: messages +!Module methodsFor: 'services' stamp: 'KenD 1/Jul/2026, 7:37:23 pm (UTC)'! +import: aName from: moduleName as: newName + | module import | + module := Kernel load: moduleName. + import := module namespace at: aName. + self bind: import as: newName ! ! -!SBraceNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! -nodesDo: aBlock includingDeclarations: aBoolean - super nodesDo: aBlock includingDeclarations: aBoolean. - elements do: [:n | n nodesDo: aBlock includingDeclarations: aBoolean] +!Module methodsFor: 'services' stamp: 'KenD 1/Jul/2026, 7:38:33 pm (UTC)'! +importDescriptor: descriptor + | moduleName token exportNames | + moduleName := descriptor key. + token := descriptor value. + exportNames := token isArray ifTrue: [token] ifFalse: [{token}]. + exportNames do: [:aName | self import: aName from: moduleName] ! ! -!SCascadeNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -acceptVisitor: visitor - ^visitor visitCascade: self +!Module methodsFor: 'services' stamp: 'KenD 1/Jul/2026, 7:38:42 pm (UTC)'! +importRequiredModules + requires do: [:aName | self import: aName]. + self imports do: [:descriptor | self importDescriptor: descriptor] ! ! -!SCascadeNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasAssign - receiver hasAssign ifTrue: [^true]. - messages detect: [:msg | msg hasAssign] ifNone: [^false]. - ^true +!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +imports + " + Returns an array of import descriptors. A descriptor can be: + - A composite symbol (i.e #Core.Modules.Writer) (NOT IMPLEMENTED YET). + - An association of module name and exported name (i.e #Core.Modules.JSON -> #Writer) + - An association of module name, exported name and rename (i.e. #Core.Modules.JSON -> (#Writer -> #JSONWriter)) (NOT IMPLEMENTED YET) + " + ^#() ! ! -!SCascadeNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! -isCascade - ^true +!Module methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicInitialize + name := self defaultName. + namespace ifNil: [namespace := Namespace new]. + exports := Set new. + cachedLookups := Dictionary new. + classes := OrderedCollection new. + extensions := Dictionary new. + overriden := Dictionary new. + requires := #() ! ! -!SCascadeNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! -nodesDo: aBlock includingDeclarations: aBoolean - super nodesDo: aBlock includingDeclarations: aBoolean. - receiver nodesDo: aBlock includingDeclarations: aBoolean. - messages do: [:msg | msg nodesDo: aBlock includingDeclarations: aBoolean] +!Module methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +defaultName + | classname | + classname := self class name. + (classname endsWith: 'Module') ifTrue: [^classname trimTail: 'Module']. + (classname beginsWith: 'Module') ifTrue: [^classname trimPrefix: 'Module']. + ^classname ! ! -!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -messages - ^messages +!Module methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bindAll: aDictionary + aDictionary keysAndValuesDo: [:symbol :value | + namespace at: symbol put: value. + self justDefined: symbol]. ! ! -!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -messages: aCollection - messages := aCollection +!Module methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +justDefined: aSymbol + | lookups | + lookups := cachedLookups at: aSymbol ifAbsent: [^nil]. + lookups do: [:lookup | lookup flush] ! ! -!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -receiver - ^receiver +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +classes + ^classes ! ! -!SCascadeNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -receiver: rcvr - receiver := rcvr +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +extensions + ^extensions ! ! -!SCommentNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isComment - ^true +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +justLoaded + self bind ! ! -!SCommentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -value - ^value +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +name + ^name ! ! -!SCommentNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -value: aString - value := aString +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +name: aString + name := aString ! ! -!SIdentifierNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -acceptVisitor: visitor - ^visitor visitIdentifier: self +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +namespace + ^namespace ! ! -!SIdentifierNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -beAssigned - | immutable | - binding canBeAssigned ifTrue: [^self]. - immutable := binding isClassBinding - ifTrue: ['class'] - ifFalse: [compiler activeScope describe: binding name]. - self compileError: 'cannot assign to ' , immutable +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +originalMethodFor: aCompiledMethod + aCompiledMethod module == self ifTrue: [^aCompiledMethod]. + ^overriden at: aCompiledMethod signature ifAbsent: nil ! ! -!SIdentifierNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -resolveAssigning: aBoolean - binding := compiler activeScope resolve: name. - ^binding +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +overriden + ^overriden +! ! +!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +requires + ^requires ! ! -!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -binding - ^binding +!Module methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +classNamed: aString + ^classes detect: [:cls | cls name = aString ] ifNone: nil ! ! -!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -binding: aBinding - binding := aBinding +!Module methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +extensionClasses + ^extensions keys + collect: [:s | | key | + key := (s endsWith: ' class') ifTrue: [(s trimTail: ' class') asSymbol] ifFalse: [s]. + namespace at: key ifAbsent: [Class new name: (s , '__Not_Found') asSymbol]] ! ! -!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - binding := DynamicBinding default +!Module methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isModule + ^true ! ! -!SIdentifierNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -name - ^name +!Module class methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new + ^self basicNew basicInitialize ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -checkLowercase - | char | - char := name first. - (char isLetter and: [char isUppercase]) ifFalse: [^self]. - self compileWarning: name storeString , ' should start with lowercase' +!ArgParserModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +imports + ^{ + #Kernel -> #(Error OrderedDictionary). + } ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isEvaluable - ^self isIdentifierLiteral +!CodeSpecsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +imports + ^{ + #Kernel -> #(#OrderedDictionary). + } ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isIdentifier - ^true +!TestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +imports + ^{ + #Kernel -> #(Array Error Exception OrderedCollection UndefinedObject WideString WideSymbol). + #Compiler -> #(SCompiler SCompilationError SMethodNode SSelectorNode SMessageNode SStringToken InlinedArgEnvironment MethodScope). + #SUnit -> #(TestCase TestResult TestSuite) + } ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isIdentifierLiteral - binding isDynamic ifFalse: [^binding isLiteral]. - ^self ast ifNil: [false] ifNotNil: [:ast | | b | - b := ast scope resolve: name. - b isLiteral] +!TestsModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! +main: anArray + | suite result | + Kernel log: 'Running Compiler tests... +'. + suite := TestSuite forModule: self. + Kernel log: 'suite built with ', suite tests size printString, ' tests +'. + result := suite run. + Kernel log: 'Done. +'. + Kernel log: result printString. + Kernel log: ' +' ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isImmediate - ^true +!CompilerModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + TreecodeEncoder initializeBindingIds; initializeTreecodeIds. + self initializeClosureElementIds ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isLocal - ^binding isLocal +!CompilerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +imports + ^{ + #Kernel -> #(Error ByteArray CompiledBlock Module NumberParser Species OrderedDictionary) + } ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isMethodArgument - | ast | - binding isArgument ifFalse: [^false]. - ast := self ast ifNil: [^false]. - ^ast arguments includes: self declaration +!CompilerModule methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeClosureElementIds + self namespace + at: #CaptureSelf put: 0; + at: #CaptureLocalArgument put: 1; + at: #CaptureEnvironment put: 2; + at: #CaptureEnvironmentValue put: 3; + at: #CaptureInlinedArgument put: 4 ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isMethodTemporary - ^self ast temporaries includes: self declaration +!LMRModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +imports + ^{ + #Kernel -> #(ProcessStack ProtoObject SequenceableCollection WordSize). + #Kernel.LMR -> #(LMRProtoObject) + } ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isSelf - ^binding isSelf +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +globalNamed: aSymbol + | index | + index := self class indexOfGlobal: aSymbol. + ^globals at: index ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isSuper - ^binding isSuper +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +globalNamed: aSymbol put: anObject + | index | + index := self class indexOfGlobal: aSymbol. + globals at: index put: anObject ! ! -!SIdentifierNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -sourceIntervals - | stretchs declaration ast string code index | - stretchs := OrderedCollection new. - declaration := binding declaration. - ast := self ast. - ast allNodesDo: [:node | - (node class == self class and: [node binding declaration == declaration]) - ifTrue: [stretchs add: node stretch]]. - string := self source. - code := compiler sourceCode. - index := ast stretch end. - [ - index := code indexOfString: string startingAt: index + 1. - index > 0] - whileTrue: [stretchs add: (index to: index + string size - 1)]. - ^stretchs +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +globals + ^globals ! ! -!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -declaration - ^binding declaration +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +invokeStub + ^(self globalNamed: #Invoke) code ! ! -!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -defineArgumentIn: aScriptScope - binding := aScriptScope defineArgument: name. - binding declaration: self +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +lookup + ^self globalNamed: #Lookup ! ! -!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -defineTemporaryIn: scope - binding := scope defineTemporary: name. - binding declaration: self +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +lookupDebuggableStub + ^(self globalNamed: #DebuggableLookup) code ! ! -!SIdentifierNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -printOn: aStream - aStream nextPut: $<; - nextPutAll: name; - nextPutAll: '> ('. - super printOn: aStream. - aStream nextPut: $) +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +lookupStub + ^(self globalNamed: #Lookup) code ! ! -!SIdentifierNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! -name: aString - name := aString reduced +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +lookupSuper + | index | + index := self class indexOfGlobal: #LookupSuper. + ^globals at: index ! ! -!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -acceptVisitor: visitor - ^visitor visitLiteral: self +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +lookupSuperDebuggableStub + | index | + index := self class indexOfGlobal: #DebuggableLookupSuper. + ^(globals at: index) code ! ! -!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -hasSymbol - ^value isSymbol +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +lookupSuperStub + | index | + index := self class indexOfGlobal: #LookupSuper. + ^(globals at: index) code ! ! -!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isEvaluable - ^true +!LMRModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +safepoint + ^(self globalNamed: #Safepoint) code ! ! -!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isImmediate - ^true +!LMRModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initializeGlobalsWithStubs + | items | + globals := Array new: self class globalNames size. + + self globalNamed: #SmallIntegerBehavior put: SmallInteger instanceBehavior. + + items := Dictionary withAll: { + #Lookup -> (NativeCode new code: 'Lookup Placeholder'). + #LookupSuper -> (NativeCode new code: 'LookupSuper Placeholder'). + #DebuggableLookup -> (NativeCode new code: 'DebuggableLookup placeholder'). + #DebuggableLookupSuper -> (NativeCode new code: 'DebuggableLookupSuper placholder'). + #Invoke -> (NativeCode new code: 'Invoke placeholder'). + #Safepoint -> (NativeCode new code: 'SafepointCheck placeholder'). + #WriteBarrier -> (NativeCode new code: 'Write Barrier placeholder')}. + items + keysAndValuesDo: [ :key :placeholder | self globalNamed: key put: placeholder ] ! ! -!SLiteralNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isLiteral - ^true +!LMRModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initializeMemory + | kernel | + kernel := GCSpace new. + kernel name: 'Kernel'. + memory := Memory new + addKernelSpace: kernel; + fromSpace: kernel; + eden: kernel ! ! -!SLiteralNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! -beSymbol - value := value asSymbol +!LMRModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +justLoaded + super justLoaded. + SendSite initializeFormatFlags. + GlobalDispatchCache initialize. + self + initializeMemory; + initializeGlobalsWithStubs. ! ! -!SLiteralNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! -value - ^value +!LMRModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +mapGlobal: aSymbol to: nativeCode + placeholder := self globalNamed: aSymbol. + placeholder code become: nativeCode code. + placeholder become: nativeCode. ! ! -!SLiteralNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! -value: anObject - value := anObject +!LMRModule class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +globalNames + ^#(Lookup LookupSuper WriteBarrier Safepoint SmallIntegerBehavior Invoke DebuggableLookup DebuggableLookupSuper) ! ! -!SNumberNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -acceptVisitor: visitor - ^visitor visitNumberNode: self +!LMRModule class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +indexOfGlobal: aSymbol + ^self globalNames + indexOf: aSymbol + ifAbsent: [self error: 'global not found'] ! ! -!SNumberNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isNumberNode - ^true +!SExpressionsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +imports + ^{ + } ! ! -!SNumberNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -negate - value := value negated +!SExpressionsModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +justLoaded + super justLoaded. + TreecodeDecoder initializePools; initializeBindingTypes; initializeNodeTypes ! ! -!SMessageNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -acceptVisitor: visitor - ^visitor visitMessage: self +!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addCommand: aString description: aDescription action: aSymbol + | command | + command := Command new + name: aString; + description: aDescription. + command action: [:result | self perform: aSymbol with: result]. + parser addCommand: command. + ^command ! ! -!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -arguments - ^arguments +!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadConfig + | host | + config := Config load. + host := Kernel host. + config modulePaths do: [:path | + host prependSearchPath: path type: #tonel. + host prependSearchPath: path type: #ems] ! ! -!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -arguments: aCollection - arguments := aCollection +!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +setupParser + | create | + parser := ArgParser new name: 'epm'; description: 'Egg Package Manager'. + create := self addCommand: 'new' description: 'Create a new project' action: #commandNew:. + create addPositional: 'name'. + self addCommand: 'init' description: 'Initialize epm.toml in current directory' action: #commandInit:. + self addCommand: 'start' description: 'Run current project' action: #commandStart:. + self addCommand: 'dev' description: 'Start development environment for current project' action: #commandDev:. + self addCommand: 'install' description: 'Install dependencies from epm.toml' action: #commandInstall:. + self addCommand: 'list' description: 'List project dependencies' action: #commandList:. + ((self addCommand: 'test' description: 'Run tests for a module' action: #commandTest:) + addPositional: 'module'; + addOption: (Option new + long: '--debug'; + description: 'Run tests without swallowing exceptions'; + beFlag; + yourself)) ! ! -!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -receiver - ^receiver +!EPMModule methodsFor: 'commands' stamp: 'KenD 1/Jul/2026, 7:39:29 pm (UTC)'! +commandDev: aResult + | cwd aName dev module | + cwd := Kernel currentDirectory. + aName := cwd copyAfterLast: $/. + dev := Kernel load: #Development. + module := Kernel load: aName asSymbol. + dev main: args ! ! -!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -receiver: node - receiver := node +!EPMModule methodsFor: 'commands' stamp: 'KenD 1/Jul/2026, 7:39:50 pm (UTC)'! +commandInit: aResult + | cwd aName generator | + cwd := Kernel currentDirectory. + aName := cwd copyAfterLast: $/. + aName isEmpty ifTrue: [aName := 'myproject']. + generator := ProjectGenerator new. + generator name: aName. + generator dir: cwd. + generator generateToml. + Kernel log: 'Initialized epm.toml for: ', aName ! ! -!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -selector - ^selector +!EPMModule methodsFor: 'commands' stamp: 'KenD 1/Jul/2026, 7:40:07 pm (UTC)'! +commandInstall: aResult + | dependencies | + config ifNil: [self loadConfig]. + dependencies := config dependencies. + dependencies isEmpty ifTrue: [ + Kernel log: 'No dependencies to install'. + ^self]. + Kernel log: 'Installing dependencies...'. + dependencies keysAndValuesDo: [:aName :constraint | + Kernel log: ' ', aName, ' (', constraint asString, ')']. + Kernel log: 'Done' ! ! -!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -selector: node - selector := node +!EPMModule methodsFor: 'commands' stamp: 'KenD 1/Jul/2026, 7:40:56 pm (UTC)'! +commandList: aResult + | dependencies | + config ifNil: [self loadConfig]. + dependencies := config dependencies. + dependencies isEmpty ifTrue: [ + Kernel log: 'No dependencies'. + ^self]. + Kernel log: config name ifNil: ['(unnamed project)']. + dependencies keysAndValuesDo: [:aName :constraint | + Kernel log: ' ', aName, ' ', constraint asString] ! ! -!SMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -symbol - ^selector symbol +!EPMModule methodsFor: 'commands' stamp: 'KenD 1/Jul/2026, 7:41:17 pm (UTC)'! +commandNew: aResult + | aName generator | + aResult positionals isEmpty ifTrue: [ + ^self error: 'Usage: epm new ']. + aName := aResult positionalAt: 1. + generator := ProjectGenerator new. + generator name: aName. + generator generate. + Kernel log: 'Created project: ', aName ! ! -!SMessageNode methodsFor: 'emitting - inlined' stamp: 'KenD 28/Jun/2026 13:27:40'! -beInlined - inlined := true +!EPMModule methodsFor: 'commands' stamp: 'KenD 1/Jul/2026, 7:41:28 pm (UTC)'! +commandStart: aResult + | cwd aName module | + cwd := Kernel currentDirectory. + aName := cwd copyAfterLast: $/. + module := Kernel load: aName asSymbol. + module main: args ! ! -!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasAssign - receiver hasAssign ifTrue: [^true]. - ^arguments anySatisfy: [:arg | arg hasAssign] +!EPMModule methodsFor: 'commands' stamp: 'KenD 1/Jul/2026, 7:41:49 pm (UTC)'! +commandTest: aResult + | aName module positionals | + positionals := aResult positionals. + aName := positionals isEmpty + ifTrue: [self projectName] + ifFalse: [positionals first]. + aName ifNil: [ + ^self error: 'Usage: epm test [module-name]']. + module := Kernel load: (aName, '.Tests') asSymbol. + (aResult optionAt: 'debug') == true + ifTrue: [self debugTestModule: module] + ifFalse: [module main: args] ! ! -!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasVolatileArguments - ^arguments anySatisfy: [:arg | - arg isIdentifier - ifTrue: [arg binding canBeAssigned] - ifFalse: [arg isBlockNode not andNot: [arg isLiteral]]] +!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +debugTestModule: aModule + Kernel log: 'Running ', aModule name, ' tests in debug mode...'; log: String cr. + (TestSuite forModule: aModule) runDebug. + Kernel log: 'Done.'; log: String cr ! ! -!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasVolatileReceiver - ^ compiler hasBlocks - or: [ receiver isMethodTemporary not ] - or: [ arguments anySatisfy: [ :arg | arg hasAssign ] ] +!EPMModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +imports + ^{ + #Kernel -> #(Error OrderedDictionary). + #ArgParser -> #(ArgParser Command Option). + #SUnit -> #(TestSuite). + #TOML -> #(TOMLParser TOMLWriter). + } ! ! -!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - inlined := false +!EPMModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +main: aCollection + | params | + args := aCollection. + self loadConfig. + self setupParser. + params := OrderedCollection new. + 3 to: args size do: [:i | + | arg | + arg := args at: i. + params add: arg]. + parser parse: params asArray ! ! -!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isCascadeMessage - ^false +!EPMModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +projectName + ^config ifNotNil: [config name] ! ! -!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isInlined - ^inlined +!ImageSegmentBuilderModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +imports + ^{ + #Kernel -> { + #Behavior. #Boolean. #False. #HashTable. #IdentityDictionary. #IdentitySet. #KernelModule. + #Module. #Symbol. #SymbolicReference. #True. #UndefinedObject + } + } ! ! -!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isMessageNode - ^true +!KernelModule methodsFor: 'snapshotting' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +prepareForSnapshot: aBuilder + | dict loaders | + dict := Dictionary new. + dict at: #Kernel put: self. + loaders := OrderedCollection new. + loaders add: moduleLoaders first. + aBuilder + addNilToken; + map: loadedModules to: dict; + map: moduleLoaders to: loaders +! ! + +!KernelModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bootstrap + | shift | + CompiledBlock initializeFormatFlags. + CompiledMethod initializeFormatFlags. + Species initializeFormatFlags. + Character initializeCharacters; initializeNamedCharacters; initializeLatin1Tables. + Closure initializeIndexes. + Float initializeConstants. + HashTable initializeConstants; initializeSizes. + HashTablePolicy initializeEmptySlot. + HashedCollection initializePolicies. + LargeInteger initializeBase. + LargeNegativeInteger initializeConstants. + SmallInteger initializeConstants. + cachedLookups := Dictionary new. + shift := WordSize = 8 ifTrue: [3] ifFalse: [2]. + namespace + at: #nil put: nil; + at: #true put: true; + at: #false put: false; + at: #WordSize put: WordSize; + at: #WordSizeShift put: shift; + at: #Kernel put: self; + at: #KnownSymbols put: #(+ - < > <= >= = == not); + at: #Processor put: ProcessorScheduler new. + StarToken initializeCurrent. + utf8 := UTF8 new. + utf16 := UTF16 new. + utf32 := UTF32 new. + Symbol initializeSymbolTable. + namespace at: #SymbolTable put: Symbol symbolTable. + Stream initializePools. + CharacterArray initializePools. + ProtoObject initializeConstants; initializeBitMasks. + + #FFICall. "hack to have this symbol (used by primitiveFFICall) in kernel ims" + self initialize. + CRITICAL := false. + self suspendOnUnhandledExceptions +! ! + +!KernelModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +addModuleLoader: aModuleLoader + moduleLoaders add: aModuleLoader +! ! + +!KernelModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initialize + " + We cannot use addClass: because it creates new symbol instances, which must be + avoided during bootstrap (else we would end with duplicated symbols) + " + self basicInitialize; freezeOnUnhandledExceptions. + host := HostSystem new. + moduleLoaders := OrderedCollection new. + loadedModules := Dictionary new. + loadedModules at: #Kernel put: self. + namespace + keys do: [:symbol | | obj | + obj := namespace at: symbol. + obj isClass ifTrue: [classes add: obj]. + exports add: symbol]. + session := SmalltalkSession new. + properties := WeakIdentityDictionary new. + ! ! -!SMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -needsStrictEvaluationOrder - arguments size = 0 ifTrue: [^false]. - receiver isBlockNode ifTrue: [^false]. - receiver isLiteral ifTrue: [^false]. - receiver isSelf ifTrue: [^false]. - receiver isSuper ifTrue: [^false]. - receiver isMethodArgument ifTrue: [^false]. - self hasVolatileReceiver ifFalse: [^false]. - (receiver isImmediate - and: [arguments conform: [:arg | arg isImmediate or: [arg isBlockNode]]]) - ifTrue: [^false]. - receiver hasAssign ifTrue: [^true]. - receiver isMessageNode ifTrue: [ ^true ]. - ^self hasVolatileArguments +!KernelModule methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +rehashWeakRegistries + session rehashWeakRegistries. + properties rehash ! ! -!SMessageNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! -nodesDo: aBlock includingDeclarations: aBoolean - super nodesDo: aBlock includingDeclarations: aBoolean. - receiver nodesDo: aBlock includingDeclarations: aBoolean. - arguments do: [:arg | arg nodesDo: aBlock includingDeclarations: aBoolean]. - selector nodesDo: aBlock includingDeclarations: aBoolean +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +createDirectory: aString + ^host createDirectory: aString ! ! -!SCascadeMessageNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -acceptVisitor: visitor - ^visitor visitCascadeMessage: self +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +critical: aBlock + "critical meaning is: run without GC and without interrupts. On unhandled errors, don't + try to halt this process and continue with others, just freeze this OS process or exit." + prev := CRITICAL. + CRITICAL := true. + result := aBlock value. + CRITICAL := prev. + aBlock value ! ! -!SCascadeMessageNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -cascade: aCascadeNode - cascade := aCascadeNode. - receiver := cascade receiver +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +currentDirectory + ^host currentDirectory ! ! -!SCascadeMessageNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -from: aMessageNode - arguments := aMessageNode arguments. - receiver := aMessageNode receiver. - selector := aMessageNode selector. - inlined := aMessageNode isInlined. - stretch := aMessageNode stretch. - comments := aMessageNode comments +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +freezeOnUnhandledExceptions + unhandledErrorHandler := [:exception | self _halt] +! ! + +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +getEnv: aString + ^host getEnv: aString ! ! -!SCascadeMessageNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isCascadeMessage - ^true +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +load: aSymbol + | filename | + loadedModules at: aSymbol ifPresent: [:module | ^module]. + moduleLoaders do: [:loader | + (loader load: aSymbol) ifNotNil: [:module | + loadedModules at: aSymbol put: module. + ^module]]. + ^self error: 'module not found' ! ! -!SCascadeMessageNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! -nodesDo: aBlock includingDeclarations: aBoolean - aBlock value: self. - arguments do: [:arg | arg nodesDo: aBlock includingDeclarations: aBoolean] +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +loadModuleFromPath: aString + ^host loadModuleFromPath: aString ! ! -!SReturnNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -acceptVisitor: visitor - ^visitor visitReturn: self +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +pathExists: aString + ^host pathExists: aString ! ! -!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -expression - ^expression +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +prepareForExecution: aCompiledMethod + self errorVMSpecific ! ! -!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -expression: node - expression := node +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +readFile: filename + ^host readFile: filename ! ! -!SReturnNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -return: aSmalltalkToken - return := aSmalltalkToken +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +suspendOnUnhandledExceptions + unhandledErrorHandler := [:exception | self suspendBecause: exception] ! ! -!SReturnNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasAssign - ^expression hasAssign +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +terminateOnUnhandledExceptions + unhandledErrorHandler := [:exception | self terminateSessionBecause: exception description] ! ! -!SReturnNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isReturn - ^true +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +terminateSessionBecause: aString + host logError: aString; logError: Processor activeProcess backtrace; exit: -1 ! ! -!SReturnNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! -nodesDo: aBlock includingDeclarations: aBoolean - super nodesDo: aBlock includingDeclarations: aBoolean. - expression nodesDo: aBlock includingDeclarations: aBoolean +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +unhandledException: anException + | debuggable | + CRITICAL ifTrue: [self _error: 'process failed in a critical moment']. + unhandledErrorHandler value: anException ! ! -!SScriptNode methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:40'! -addChild: aBlockNode - children add: aBlockNode +!KernelModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +writeFile: aFilename contents: aString + ^host writeFile: aFilename contents: aString ! ! -!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -addStatements: anOrderedCollection - statements addAll: anOrderedCollection +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +ensurePropertyTableFor: anObject + ^properties at: anObject ifAbsentPut: [IdentityDictionary new] ! ! -!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -identifiers - | result | - result := OrderedCollection new. - self nodesDo: [:node | node isIdentifier ifTrue: [result add: node]]. - ^result withoutDuplicates +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +exit + host exit: 0 ! ! -!SScriptNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - statements := OrderedCollection new. - arguments := #(). - temporaries := #(). - children := OrderedCollection new +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +finalizer + ^session finalizer ! ! -!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -arguments - ^arguments +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +host + ^host ! ! -!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -arguments: aCollection - arguments := aCollection +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +loadedModules + ^loadedModules ! ! -!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -children - ^children +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +memory + ^memory ! ! -!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentSize - ^scope environmentSize +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +processor + ^Processor ! ! -!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -realScript - self subclassResponsibility +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +properties + ^properties ! ! -!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -statements - ^statements +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +propertiesFor: anObject + ^properties at: anObject ifAbsent: nil ! ! -!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -temporaries - ^temporaries +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +unhandledExceptionHandler: aClosure + unhandledErrorHandler := aClosure ! ! -!SScriptNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -temporaries: aCollection - temporaries := aCollection +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +utf16 + ^utf16 ! ! -!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -bindLocals - arguments do: [:arg | arg defineArgumentIn: scope]. - temporaries do: [:temp | temp checkLowercase; defineTemporaryIn: scope]. - children do: [:block | block bindLocals] +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +utf32 + ^utf32 ! ! -!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -positionLocals - scope positionLocals. - children do: [:b | b positionLocals] +!KernelModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +utf8 + ^utf8 ! ! -!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -reference: aBinding - aBinding beReferencedFrom: self +!KernelModule methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +ephemeronsDo: aBlock + session ephemeronsDo: aBlock. + properties ephemeronsDo: aBlock ! ! -!SScriptNode methodsFor: 'binding' stamp: 'KenD 28/Jun/2026 13:27:40'! -scope - ^scope +!KernelModule methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +loadedModuleNamed: aSymbol + ^loadedModules at: aSymbol ifAbsent: [] ! ! -!SScriptNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasAssign - statements do: [:s | s hasAssign ifTrue: [^true]]. - ^false +!KernelModule methodsFor: 'logging' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +log: aString + ^host log: aString level: 2 ! ! -!SScriptNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:40'! -nodesDo: aBlock includingDeclarations: aBoolean - super nodesDo: aBlock includingDeclarations: aBoolean. - aBoolean ifTrue: [ - arguments do: [:a | a nodesDo: aBlock includingDeclarations: aBoolean]. - temporaries do: [:a | a nodesDo: aBlock includingDeclarations: aBoolean]]. - statements do: [:s | s nodesDo: aBlock includingDeclarations: aBoolean] +!KernelModule methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeKey: aSymbol from: aMethodDictionary ifAbsent: aBlock + | cm | + cm := aMethodDictionary at: aSymbol ifAbsent: [^aBlock value]. + ^aMethodDictionary basicRemoveKey: aSymbol asSymbol ifAbsent: aBlock ! ! -!SScriptNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -useSelf - scope captureSelf +!KernelModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +suspendBecause: anException + | active process | + active := Processor activeProcess. + process := Process sending: #suspended:because: to: host with: {active. anException}. + process takeControl ! ! -!SBlockNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:40'! -acceptVisitor: visitor - ^visitor visitBlock: self +!KernelModule methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +useHostModuleLoader + host setupDefaultSearchPaths. + self addModuleLoader: host. ! ! -!SBlockNode methodsFor: 'emitting - inlined' stamp: 'KenD 28/Jun/2026 13:27:40'! -beInlined - inlined := true. - arguments do: [:arg | arg binding beInlined] +!ModuleImporterModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +imports + ^{ + #Kernel -> #(#InternalReadStream #Character #CharacterArray #IdentitySet #Module). + #Tonel -> #(#TonelReader). + #CodeSpecs -> #(#ModuleSpec #ClassSpec #MetaclassSpec #MethodSpec). + #STON -> #(#STONReader). + #Compiler -> #(#SCompiler). + } ! ! -!SBlockNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -buildBlock - | block | - self isInlined ifTrue: [ ^ nil ]. - block := CompiledBlock new. - ^ block - blockNumber: index; - argumentCount: arguments size; - tempCount: scope stackSize; - environmentCount: scope environmentSize; - capturesSelf: scope capturesSelf; - capturesHome: scope capturesHome +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +bootstrap: anLMRModule with: aPlatform + environment := self newNativizationEnvironmentFor: aPlatform. + + self + nativizeInvokeFor: anLMRModule; + nativizeWriteBarrierFor: anLMRModule; + nativizeLookupFor: anLMRModule; + nativizeSendSiteStubs. + + environment initializeLinkersFor: anLMRModule; completeInitialization +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeFor: anLMRModule with: aPlatform + environment := self newNativizationEnvironmentFor: aPlatform. + environment initializeLinkersFor: anLMRModule; completeInitialization +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizeInvokeFor: anLMRModule + | invoke | + invoke := SendSite >> #_invokeOn:. + environment nativizeOptimizing: invoke. + anLMRModule mapGlobal: #Invoke to: invoke +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizeLookupFor: anLMRModule + | nativizer lookup lookupSuper | + nativizer := LookupNativizer new + environment: environment; + nativizeMethods. + lookup := nativizer methodFor: #_dispatchOn:. + lookupSuper := nativizer methodFor: #_dispatchOn:startingAt:. + anLMRModule + mapGlobal: #Lookup to: lookup executableCode; + mapGlobal: #LookupSuper to: lookupSuper executableCode +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizeMonomorphicCache + | asm lookup next smiGlobal lookupGlobal | + asm := environment newAssembler. + lookup := asm newLabel. + smiGlobal := self indexOfGlobal: #SmallIntegerBehavior. + lookupGlobal := self indexOfGlobal: #Lookup + asm + loadTwithAindex: 3; + loadSwithGindex: smiGlobal. + next := asm labeledNonIntegerBitTestOfR. + asm + loadLongSwithRindex: 0; + @ next; + compareSwithTindex: 1; + shortJumpIfNotEqualTo: lookup; + loadMwithTindex: 2; + jumpToMindex: 1; + @ lookup; + loadMwithGindex: lookupGlobal; + jumpToMindex: 1; + applyFixups. + ^asm nativeCode code +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizePolymorphicCache + | asm smi lookupGlobal case2 case3 case4 case5 case6 case7 lookup | + asm := environment newAssembler. + smi := asm newLabel. + case2 := asm newLabel. + case3 := asm newLabel. + case4 := asm newLabel. + case5 := asm newLabel. + case6 := asm newLabel. + case7 := asm newLabel. + lookup := asm newLabel. + asm loadTwithAindex: 3. + smi := asm labeledNonIntegerBitTestOfR. + lookupGlobal := self indexOfGlobal: #Lookup. + asm + loadLongSwithRindex: 0; + compareSwithTindex: 1; + shortJumpIfNotEqualTo: case2; + loadMwithTindex: 2; + jumpToMindex: 1; + @ case2; + compareSwithTindex: 3; + shortJumpIfNotEqualTo: case3; + loadMwithTindex: 4; + jumpToMindex: 1; + @ case3; + compareSwithTindex: 5; + shortJumpIfNotEqualTo: case4; + loadMwithTindex: 6; + jumpToMindex: 1; + @ case4; + compareSwithTindex: 7; + shortJumpIfNotEqualTo: case5; + loadMwithTindex: 8; + jumpToMindex: 1; + @ case5; + compareSwithTindex: 9; + shortJumpIfNotEqualTo: case6; + loadMwithTindex: 10; + jumpToMindex: 1; + @ case6; + compareSwithTindex: 11; + shortJumpIfNotEqualTo: case7; + loadMwithTindex: 12; + jumpToMindex: 1; + @ case7; + compareSwithTindex: 13; + shortJumpIfNotEqualTo: lookup; + loadMwithTindex: 14; + jumpToMindex: 1; + @ lookup; + loadMwithGindex: lookupGlobal; + jumpToMindex: 1; + @ smi; + loadMwithTindex: 15; + jumpToMindex: 1; + applyFixups. + ^asm nativeCode code +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizeSendSiteStubs + SendSite + monomorphicCache: self nativizeMonomorphicCache; + polymorphicCache: self nativizePolymorphicCache. +! ! + +!NativizerModule methodsFor: 'bootstrapping' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizeWriteBarrierFor: anLMRModule + | map inlined barrier dispatcher | + map := { + (Memory class -> #(current)). + (Memory -> #(isYoung: isYoungSafe: remember:)). + (CriticalArray -> #(unsafeAdd: #unsafeAt:put:)). + (Magnitude -> #(#between:and:)) + }. + inlined := self methodSubset: map. + inlined addAll: self undermethods. + barrier := ProtoObject >> #holdRefererIfNeeded:. + dispatcher := LookupLinker new initializeFrom: nativizer. + NativizationEnvironment new + platform: environment platform; + inlinedMethods: inlined; + messageLinker: dispatcher; + completeInitialization; + nativizeOptimizing: barrier. + anLMRModule mapGlobal: #WriteBarrier to: barrier executableCode +! ! + +!NativizerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +environment + ^environment ! ! -!SBlockNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -captureHome - scope captureEnvironment: self ast +!NativizerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +imports + ^{ + #Kernel -> #(Behavior CharacterArray Closure CompiledBlock CompiledMethod Float OrderedCollection ProtoObject Species String). + #Kernel.LMR -> #(LMRProtoObject LMRFloat LMRSpecies). + #LMR -> #(CriticalArray GCSpace GlobalDispatchCache Memory NativeCode SendSite Thread). + } ! ! -!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -environmentIndexOf: aParseNode - ^scope environmentIndexOf: aParseNode +!NativizerModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlinedMethods + | map | + map := { + (ProtoObject -> #(#basicObjectIndexOf: #class #objectAtValid: #objectAtValid:put:)). + (LMRProtoObject -> #(#behavior #primitiveAt: #_cachedLookup: #_cachedLookup:in:)). + (Object -> #(#byteAtValid: #byteAtValid:put: #at:put:)). + (Species -> #(#instSize #_instancesAreArrayed #_instancesHavePointers #instanceBehavior)). + (LMRSpecies -> #(#memory #primitiveNew #primitiveNew:)). + (CompiledMethod -> #(#prepareForExecution #isNativized #executableCode #blockCount #literalIndexFrom:)). + (CompiledBlock -> #(#argumentCount #blockNumber #blockCode #method)). + (NativeCode -> #(#code)). + (GCSpace -> #(#commitedLimit #nextFree #nextFree:)). + (CharacterArray -> #(#characterAtValid:))}. + ^self undermethods , (self methodSubset: map) +! ! + +!NativizerModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +invokedMethods + | map | + map := { + (ProtoObject -> #(class)). + (LMRProtoObject -> #(behavior #initializeExtended:contentSize: primitiveAt:)). + (Object -> #(_replaceFrom:to:with:)). + (Species -> #(instanceBehavior _instancesAreArrayed _instancesHavePointers)). + (LMRSpecies -> #(allocate:size: nil:slotsOf: memory primitiveNewBytes: primitiveNewPointers: zero:bytesOf:))}. + ^self undermethods , (self methodSubset: map) +! ! + +!NativizerModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +justLoaded + InlineMessageLinker initializeInlineMessageLinkerFlags ! ! -!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isBlockNode - ^true +!NativizerModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodSubset: associations + | result dict | + result := OrderedCollection new. + dict := Dictionary withAll: associations. + dict keysAndValuesDo: [ :species :selectors | + selectors collect: [:sel | | m | species >> sel ifNil: [self ASSERT: false] ] in: result]. + ^result ! ! -!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isEvaluable - ^self isNullary +!NativizerModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +optimizedMethods + | map | + map := { + (ProtoObject -> #(basicByteAt: #basicByteAt:put: basicObjectAt: #basicObjectAt:put: class)). + (LMRProtoObject -> #(behavior primitiveAt: #primitiveAt:put: #initializeExtended:contentSize:)). + (Object -> #(at: #at:put: byteAtValid: #byteAtValid:put: #replaceBytesForwardFrom:to:with:startingAt:)). + (SendSite -> #(_dispatchOn: #_dispatchOn:startingAt: _dispatchDebuggableOn: #_dispatchDebuggableOn:startingAt:)). + (Species -> #(instSize)). + (LMRSpecies -> #(allocate:size: primitiveNew primitiveNew: primitiveNewBytes: primitiveNewPointers:)). + (LMRFloat class -> #(new)). + (CompiledBlock -> #(argumentCount arity blockCode method)). + (Closure -> #(value value: #value:value:)). + (CompiledMethod -> #(blockCount isNativized)). + (String -> #(at: #at:put: byteAt: #byteAt:put:)). + (GCSpace -> #(lockedAllocateIfPossible: shallowCopy:)). + (Memory -> #(shallowCopy:))}. + ^self undermethods , (self methodSubset: map) +! ! + +!NativizerModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +newNativizationEnvironmentFor: aPlatform + ^NativizationEnvironment new + platform: aPlatform; + inlinedMethods: self inlinedMethods; + invokedMethods: self invokedMethods; + optimizedMethods: self optimizedMethods +! ! + +!NativizerModule methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +undermethods + ^SendSite undermethods +! ! + +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +checkNumberEnd: position + | char | + stream atEnd ifTrue: [^self]. + char := stream peek. + char = $. ifFalse: [^self]. + stream skip: 1. + stream atEnd + ifFalse: [stream peek isDigit + ifTrue: [self error: 'invalid number' at: position]]. + stream skip: -1 ! ! -!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isInlined - ^inlined +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +completeFloat: anInteger + | tenth | + tenth := 10 raisedToInteger: self nextExponent. + ^(anInteger * tenth) asFloat ! ! -!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isNullary - ^arguments isEmpty +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +completeNumber: anInteger after: aCharacter + aCharacter = $. ifTrue: [ + ^(stream peekFor: $s) + ifTrue: [self nextScaledFrom: anInteger fractionDigits: 0] + ifFalse: [self nextFloat: anInteger]]. + (aCharacter = $e or: [aCharacter = $E]) + ifTrue: [^self completeFloat: anInteger]. + aCharacter = $r ifTrue: [^self nextIntegerRadix: anInteger]. + aCharacter = $s ifTrue: [^self nextScaledFrom: anInteger fractionDigits: 0]. + (anInteger = 0 and: [aCharacter = $x or: [aCharacter = $X]]) + ifTrue: [^self nextIntegerRadix: 16]. + stream skip: -1. + ^anInteger ! ! -!SBlockNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -usesHome - ^inlined - ifTrue: [children anySatisfy: [:block | block usesHome]] - ifFalse: [scope capturesHome] +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +completeNumber: anInteger at: start + | number | + stream atEnd ifTrue: [^anInteger]. + number := anInteger. + number := self completeNumber: anInteger after: stream next. + self checkNumberEnd: start. + ^number ! ! -!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -index - ^index +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +digitFromChar: char base: radix + | c | + char isDigit ifTrue: [^char digitValue]. + char = $r ifTrue: [^nil]. + char = $x ifTrue: [^nil]. + char = $X ifTrue: [^nil]. + c := char asUppercase. + (c asInteger between: $A asInteger and: $Z asInteger) ifFalse: [^nil]. + (c !!= $E and: [radix <= c digitValue]) ifTrue: [^nil]. + (c = $E and: [radix = 10]) ifTrue: [^nil]. + ^c digitValue ! ! -!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -index: aNumber - index := aNumber +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +endToken + self error: 'end of stream' at: stream position ! ! -!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -parent - ^parent +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +error: aString at: position + error := aString -> position. + return value: nil ! ! -!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -parent: aScriptNode - parent := aScriptNode addChild: self +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +negativeNumber + | position | + stream atEnd ifTrue: [^nil]. + stream peek isDigit ifFalse: [^nil]. + position := stream position. + ^self next key negated -> position ! ! -!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -realParent - ^parent realScript +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +next + | char | + return isNil ifTrue: [return := [:value | ^value]]. + char := self nextChar. + char isNil ifTrue: [^self endToken]. + char = $- ifTrue: [^self negativeNumber]. + char = $+ ifTrue: [^self positiveNumber]. + char isDigit ifTrue: [^self nextNumber: char]. + ^nil ! ! -!SBlockNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -realScript - ^inlined ifTrue: [parent realScript] ifFalse: [self] +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nextChar + ^stream skipWhitespace atEnd ifFalse: [stream next] ! ! -!SBlockNode methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - inlined := false. - scope := BlockScope on: self +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nextDigit: radix + | char digit | + stream atEnd ifTrue: [^nil]. + char := stream next. + digit := self digitFromChar: char base: radix. + digit isNil ifTrue: [ + stream skip: -1. + ^nil]. + radix <= digit + ifTrue: [self error: 'digit greater than radix' at: stream position]. + ^digit ! ! -!SMethodNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:41'! -acceptVisitor: visitor - ^visitor visitMethod: self +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nextExponent + | negated exp | + negated := false. + (stream peekFor: $+) ifFalse: [negated := stream peekFor: $-]. + exp := self nextIntegerRadix: 10. + negated ifTrue: [exp := exp negated]. + ^exp ! ! -!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! -buildMethod - | cm encoder treecodes | - cm := self methodClass withAll: self literals. - cm - blockCount: compiler blockCount; - tempCount: scope stackSize; - argumentCount: arguments size; - environmentCount: scope environmentSize; - capturesSelf: scope capturesSelf; - hasEnvironment: self needsEnvironment; - hasFrame: self needsFrame; - selector: self selector; - sourceObject: compiler sourceCode; - classBinding: compiler frontend classBinding. - cm pragma: pragma. - cm blocks do: [ :block | block method: cm ]. - encoder := TreecodeEncoder new method: cm. - treecodes := self acceptVisitor: encoder. - ^ cm treecodes: treecodes +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nextFloat: aNumber + | base digit e exp | + digit := self nextDigit: 10. + digit isNil ifTrue: [ + stream skip: -1. + ^aNumber]. + e := 1. + base := aNumber * 10 + digit. + [ + digit := self nextDigit: 10. + digit isNil] + whileFalse: [ + base := base * 10 + digit. + e := e + 1]. + ((stream peekFor: $E) or: [stream peekFor: $e]) ifTrue: [ + exp := self nextExponent. + ^(base * (10 raisedToInteger: exp - e)) asFloat]. + (stream peekFor: $s) ifTrue: [^self nextScaledFrom: base fractionDigits: e]. + ^(base * (10 raisedToInteger: e negated)) asFloat ! ! -!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! -captureHome - +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nextIntegerRadix: radix + | value valid digit | + value := 0. + valid := false. + [ + digit := self nextDigit: radix. + digit isNil] + whileFalse: [ + valid := true. + value := value * radix + digit]. + valid ifFalse: [self error: 'digit missing' at: stream position + 1]. + ^value ! ! -!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! -literals - | literals v l | - literals := OrderedCollection new. - pragma isUsed - ifTrue: [ literals add: pragma name ]. - self - nodesDo: [ :n | - n isLiteral - ifTrue: [ v := n value. - v isSmallInteger - ifFalse: [ literals add: v ] ]. - n isMessageNode - ifTrue: [ literals add: n symbol ]. - n isBraceNode - ifTrue: [ n isLiteral - ifTrue: [ self halt ] - ifFalse: [ literals - add: #Array; - add: #new:; - add: #at:put:; - add: #yourself ] ]. - (n isIdentifier - and: [ l := n binding literal. - l notNil ]) - ifTrue: [ literals add: l ]. - (n isBlockNode andNot: [ n isInlined ]) - ifTrue: [ literals add: n buildBlock ] ]. - ^ literals withoutDuplicates +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nextNumber: aCharacter + | start number digit | + start := stream position. + number := aCharacter digitValue. + [ + digit := self nextDigit: 10. + digit isNil] + whileFalse: [number := number * 10 + digit]. + number := self completeNumber: number at: start. + ^number -> (start thru: stream position) ! ! -!SMethodNode methodsFor: 'parsing' stamp: 'KenD 28/Jun/2026 13:27:41'! -methodClass - | type | - type := pragma type. - type = #callback - ifTrue: [ ^ CallbackMethod ]. - type = #callout - ifTrue: [ ^ CalloutMethod ]. - ^ CompiledMethod +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nextScaledFrom: aNumber fractionDigits: digits + | scale denominator sd | + scale := (stream atEnd not and: [stream peek isDigit]) + ifTrue: [self nextIntegerRadix: 10]. + denominator := 10 raisedToInteger: digits. + sd := ScaledDecimal + numerator: aNumber + denominator: denominator + scale: scale. + ^sd reduced ! ! -!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -compiler: aSmalltalkCompiler - super compiler: aSmalltalkCompiler. - scope := MethodScope new script: self. - pragma := aSmalltalkCompiler pragmaNode +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +positiveNumber + | position | + stream peek isDigit ifFalse: [^nil]. + position := stream position. + ^self next key -> position ! ! -!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -pragma - ^pragma +!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +reset + stream reset. + return := nil ! ! -!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -pragma: anObject - pragma := anObject +!NumberParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +error + ^error ! ! -!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -realScript - ^self +!NumberParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +on: aString + stream := aString readStream. + return := nil ! ! -!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -selector - ^selector value +!NumberParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nextValue + ^self next ifNil: [0] ifNotNil: [:assoc | assoc key] ! ! -!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -selector: aSelectorNode - selector := aSelectorNode +!ObjectReference methodsFor: 'actions' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +beAbsolute + absolute := true ! ! -!SMethodNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -selectorNode - ^selector +!ObjectReference methodsFor: 'actions' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +classBinding + ^source classBinding ! ! -!SMethodNode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:41'! -environmentIndexOf: aParseNode - ^nil +!ObjectReference methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +for: anObject + self target: anObject ! ! -!SMethodNode methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:41'! -header - " - (Object >> #printOn:) ast header - " - | interval | - interval := selector stretch. - arguments notEmpty - ifTrue: [interval := interval start thru: arguments last stretch end]. - ^compiler sourceCode copyFrom: interval start to: interval end +!ObjectReference methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initialize + absolute := false ! ! -!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isHeadless - ^selector isNil +!ObjectReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isAbsolute + ^absolute ! ! -!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! +!ObjectReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! isMethod - ^true + ^false ! ! -!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -needsEnvironment - ^scope environmentSize > 0 - or: [children anySatisfy: [:block | block usesHome]] +!ObjectReference methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +printOn: aStream + aStream nextPutAll: 'Ref to ' , target printString ! ! -!SMethodNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -needsFrame - scope stackSize > 0 ifTrue: [ ^ true ]. - arguments size > 16 ifTrue: [ ^ true ]. - compiler hasSends ifTrue: [ ^ true ]. - compiler hasBlocks ifTrue: [ ^ true ]. - ^ false +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +source: sourceObject + source := sourceObject ! ! -!SMethodNode methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:41'! -nodesDo: aBlock includingDeclarations: aBoolean - super nodesDo: aBlock includingDeclarations: aBoolean. - (aBoolean and: [selector notNil]) ifTrue: [aBlock value: selector] +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sourceOffset + ^sourceOffset ! ! -!SSelectorNode methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026 13:27:41'! -acceptVisitor: visitor - ^visitor visitSelector: self +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sourceOffset: aNumber + sourceOffset := aNumber ! ! -!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 30/Jun/2026 08:25:59'! -addKeyword: aSelectorNode - keywords isNil ifTrue: [keywords := OrderedCollection new]. - keywords add: aSelectorNode +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +target + ^target ! ! -!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -end - stretch end ifNotNil: [:e | ^e]. - ^keywords notNil ifTrue: [keywords last end] +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +target: anObject + target := anObject ! ! -!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -keywords - ^keywords isNil ifTrue: [{self}] ifFalse: [keywords] +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +targetOffset + ^0 ! ! -!SSelectorNode methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:41'! -positions - ^self keywords collect: [:node | node position] +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +valueToWriteAt: sourceAddress with: wordSize + ^self + valueToWriteAt: sourceAddress + targeting: target _asSmallInteger + with: wordSize ! ! -!SSelectorNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -hasSymbol - ^symbol isSymbol +!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +valueToWriteWith: wordSize + ^self valueToWriteAt: source _asSmallInteger + sourceOffset with: wordSize ! ! -!SSelectorNode methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:41'! -isSelector - ^true +!ObjectReference methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +valueToWriteAt: sourceAddress targeting: targetAddress with: wordSize + | address correction | + address := targetAddress + self targetOffset. + correction := absolute + ifTrue: [0] + ifFalse: [sourceAddress + sourceOffset + wordSize]. + ^address - correction ! ! -!SSelectorNode methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:41'! -isBinary - ^symbol isBinary +!ObjectReference class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +absoluteFor: anObject + ^(self new for: anObject) beAbsolute ! ! -!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! -symbol - ^symbol +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +args + ^args ! ! -!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! -symbol: aString - symbol := aString asSymbol +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +args: anArray + args := anArray ! ! -!SSelectorNode methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:41'! -value - ^symbol +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +finalizer + ^finalizer ! ! -!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! -acceptVisitor: aVisitor - self isFFI ifTrue: [^aVisitor visitFFIPragma: self]. - self isPrimitive ifTrue: [^aVisitor visitPrimitivePragma: self]. - self isSymbolic ifTrue: [^aVisitor visitSymbolicPragma: self] +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +name + ^name ! ! -!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! -ffi: cc name: aString with: anFFIDescriptor - type := cc. - name := aString. - info := anFFIDescriptor +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +resourceRegistry + ^resources ! ! -!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! -ffi: aString with: anFFIDescriptor - type := #ffi. - name := aString. - info := anFFIDescriptor +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +username + ^username ! ! -!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! -info - ^info +!SmalltalkSession methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +username: aString + username := aString ! ! -!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! -isUsed - ^type notNil +!SmalltalkSession methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +closeExternalResources + resources do: [:object | object sessionShutdown] ! ! -!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! -name - ^name +!SmalltalkSession methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +ephemeronsDo: aBlock + resources ephemeronsDo: aBlock. + finalizer ephemeronsDo: aBlock. ! ! -!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! -primitive: anInteger name: aString - type := #primitive. - name := aString. - info := anInteger +!SmalltalkSession methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +startUp + self initializeFinalizationBlocks. + resources do: [:object | object sessionStartup] ! ! -!SPragmaNode methodsFor: 'as yet unclassified' stamp: 'KenD 28/Jun/2026 13:27:40'! -type - ^type +!SmalltalkSession methodsFor: 'shutdown' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +exit: code + [self shutdown] ensure: [Kernel host exit: code] ! ! -!SSymbolicToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -is: anObject - ^value == anObject +!SmalltalkSession methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initialize + super initialize. + name := 'egg session'. + finalizer := WeakIdentitySet new. + resources := WeakIdentitySet new ! ! -!SSymbolicToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -value - ^value +!SmalltalkSession methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initializeFinalizationBlocks + finalizer finalizer: [:object | object finalize]. + resources finalizer: [:object | object finalize] ! ! -!SSymbolicToken methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -value: anObject - value := anObject +!SmalltalkSession methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +rehashWeakRegistries + resources rehash. + finalizer rehash ! ! -!SDelimiterToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! -asSelectorNode - ^compiler selectorNode symbol: value asString; stretch: stretch +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +add: anAssociation + self ASSERT: Smalltalk !!== self. + ^globals add: anAssociation ! ! -!SDelimiterToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! -beCharacter - value := value isCharacter ifTrue: [value] ifFalse: [value first] +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationAt: aSymbol + ^globals associationAt: aSymbol ! ! -!SDelimiterToken methodsFor: 'evaluating' stamp: 'KenD 28/Jun/2026 13:27:40'! -value: aString - super value: aString asSymbol +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationAt: aSymbol ifAbsent: aBlock + ^globals associationAt: aSymbol ifAbsent: aBlock ! ! -!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -endsExpression - ^value = $. or: [value = $]] or: [value = $)] or: [value = $}] +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationClass + ^globals associationClass ! ! -!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isAssignment - ^self is: #':=' +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +associationsDo: aBlock + globals associationsDo: aBlock +! ! + +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: aSymbol + ^globals at: aSymbol ! ! -!SDelimiterToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isDelimiter - ^true +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: aSymbol ifAbsent: aBlock + ^globals at: aSymbol ifAbsent: aBlock ! ! -!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! -asIdentifierNode - ^compiler identifierNode - name: value; - stretch: stretch; - comments: comments +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: aSymbol ifAbsentPut: aBlock + ^self at: aSymbol ifAbsent: [self at: aSymbol put: aBlock value] ! ! -!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! -asSelectorNode - ^compiler selectorNode symbol: value; stretch: stretch +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +at: aSymbol put: anObject + | key global | + key := aSymbol asSymbol. + global := globals at: key ifAbsent: nil. + global isClass ifTrue: [ + anObject == global ifTrue: [^self]. + global symbol == key + ifTrue: [^self error: 'Overriding classes is not allowed']]. + globals at: key put: anObject. + self justDefined: aSymbol. + ^anObject ! ! -!SStringToken methodsFor: 'converting' stamp: 'KenD 28/Jun/2026 13:27:40'! -isStringToken - ^true +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +classNamed: aString + | name tag meta global | + name := aString. + tag := ' class'. + meta := aString endsWith: tag. + meta ifTrue: [name := name allButLast: tag size]. + global := self at: name asSymbol ifAbsent: [^nil]. + ^global isSpecies ifTrue: [meta ifTrue: [global class] ifFalse: [global]] ! ! -!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -hasSymbol - ^value isSymbol +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +eventDispatcher + ^eventDispatcher ! ! -!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isBinary - ^value isSymbol +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +eventDispatcher: anEventDispatcher + eventDispatcher := anEventDispatcher ! ! -!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isDelimitedIdentifier - ^value first = ${ +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +finalizer + ^finalizer ! ! -!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isKeyword - ^value last = $: +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +globals + ^globals ! ! -!SStringToken methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:40'! -isNameToken - ^(self isKeyword or: [self isBinary]) not +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +globals: aNamespace + globals := aNamespace ! ! -!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -at: aString - ^merged at: aString ifAbsent: [nil] +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hasDebugger + ^false ! ! -!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -at: aString ifAbsent: aBlock - ^merged at: aString ifAbsent: aBlock +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keyAtValue: anObject + ^globals keyAtValue: anObject ! ! -!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -dependencies - ^self at: 'dependencies' ifAbsent: [OrderedDictionary new] +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +keys + ^globals keys ! ! -!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -modulePaths - | paths section | - paths := self at: 'paths'. - paths ifNil: [^#()]. - section := paths at: 'modules' ifAbsent: [nil]. - section ifNil: [^#()]. - ^section +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +messageQueue + ^eventDispatcher messageQueue ! ! -!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -name - | section | - section := self at: 'project'. - section ifNil: [^nil]. - ^section at: 'name' ifAbsent: [nil] +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nameOfGlobal: anObject + ^globals keyAtValue: anObject ! ! -!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -project - ^project +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nativizer + ^nativizer ! ! -!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -user - ^user +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +nativizer: anObject + nativizer := anObject ! ! -!Config methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -version - | section | - section := self at: 'project'. - section ifNil: [^nil]. - ^section at: 'version' ifAbsent: [nil] +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +processAllMessages + eventDispatcher processAllMessages ! ! -!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! -load - self loadUser. - self loadProject. - self merge +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +register: aSet for: aClass + registeredEvents at: aClass put: aSet ! ! -!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! -loadProject - | cwd path contents | - cwd := Kernel currentDirectory. - path := cwd, '/epm.toml'. - (Kernel pathExists: path) - ifTrue: [ - contents := Kernel readFile: path. - project := TOMLParser parse: contents] - ifFalse: [project := OrderedDictionary new] +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +registeredEventsFor: aClass + ^registeredEvents at: aClass ifAbsent: nil ! ! -!Config methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:40'! -loadUser - | home path contents | - home := Kernel getEnv: 'HOME'. - home ifNil: [user := OrderedDictionary new. ^self]. - path := home, '/.egg/config.toml'. - (Kernel pathExists: path) - ifTrue: [ - contents := Kernel readFile: path. - user := TOMLParser parse: contents] - ifFalse: [user := OrderedDictionary new] +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeClass: aClass + aClass isDeleted ifTrue: [^self]. + self devenv forgetClass: aClass. + globals basicRemoveKey: aClass symbol ifAbsent: nil. + aClass class superclass isNil + ifFalse: [aClass class superclass removeSubclass: aClass class]. + aClass superclass isNil ifFalse: [aClass superclass removeSubclass: aClass]. + aClass beDeleted ! ! -!Config methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -merge - merged := OrderedDictionary new. - self mergeFrom: user into: merged. - self mergeFrom: project into: merged +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeKey: aSymbol from: aMethodDictionary ifAbsent: aBlock + | cm | + cm := aMethodDictionary at: aSymbol ifAbsent: [^aBlock value]. + self devenv forgetMethod: cm. + ^aMethodDictionary basicRemoveKey: aSymbol asSymbol ifAbsent: aBlock ! ! -!Config methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -mergeFrom: aSource into: aTarget - aSource keysAndValuesDo: [:k :v | - | existing | - existing := aTarget at: k ifAbsent: [nil]. - (v isKindOf: OrderedDictionary) - ifTrue: [ - (existing isKindOf: OrderedDictionary) - ifTrue: [self mergeFrom: v into: existing] - ifFalse: [ - | copy | - copy := OrderedDictionary new. - self mergeFrom: v into: copy. - aTarget at: k put: copy]] - ifFalse: [aTarget at: k put: v]] +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +transcript + ^globals at: #Transcript ! ! -!Config class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:40'! -load - ^self new load +!SmalltalkSystem methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +version + ^'0.1.1' ! ! -!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -dir: aString - dir := aString +!SmalltalkSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicAdd: anAssociation + globals basicAdd: anAssociation. + self justDefined: anAssociation key. + ^anAssociation ! ! -!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -moduleName - | first | - first := name first asUppercase. - ^(String with: first), (name copyFrom: 2) +!SmalltalkSystem methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicAt: aSymbol put: anObject + | assoc | + assoc := Association key: aSymbol value: anObject. + self basicAdd: assoc. + ^anObject ! ! -!ProjectGenerator methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -name: aString - name := aString +!SmalltalkSystem methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicRemoveKey: key ifAbsent: aBlock + ^globals removeKey: key ifAbsent: aBlock ! ! -!ProjectGenerator methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -ensureDir - dir ifNil: [ - dir := Kernel currentDirectory, '/', name]. - Kernel createDirectory: dir +!SmalltalkSystem methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeKey: key + ^globals removeKey: key ! ! -!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026 13:27:40'! -generate - | modules module | - self ensureDir. - modules := dir, '/modules'. - module := modules, '/', self moduleName. - Kernel createDirectory: modules. - Kernel createDirectory: module. - self generateToml. - self generateModule: module +!SmalltalkSystem methodsFor: 'removing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeKey: aSymbol ifAbsent: aBlock + | selector global | + selector := aSymbol asSymbol. + global := globals at: selector ifAbsent: [^aBlock value]. + (global isClass and: [global symbol == selector]) ifTrue: [ + global allInstances notEmpty + ifTrue: [^self error: 'The class being removed still has instances']. + global delete. + ^selector]. + ^globals basicRemoveKey: selector ifAbsent: aBlock ! ! -!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026 13:27:40'! -generateModule: aString - | filename contents module | - module := self moduleName. - filename := aString, '/', module, 'Module.st'. - contents := '" - See (MIT) license in root directory. -" - -Class { - #name : #', module, 'Module, - #superclass : #Module, - #instVars : [], - #category : #', module, ' -} +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +beep + ^self operatingSystem beep +! ! -{ #category : #main } -', module, 'Module >> main: args [ - Kernel log: ''Hello from ', name, ''' -] -'. - Kernel writeFile: filename contents: contents +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bindEventTable: aDictionary to: anObject + aDictionary isNil + ifTrue: [eventHandlers removeKey: anObject ifAbsent: []] + ifFalse: [eventHandlers at: anObject put: aDictionary] ! ! -!ProjectGenerator methodsFor: 'generating' stamp: 'KenD 28/Jun/2026 13:27:40'! -generateToml - | filename contents | - self ensureDir. - filename := dir, '/epm.toml'. - contents := '[project] -name = "', name, '" -version = "0.1.0" -description = "" +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +collectGarbage + memory forceCompact +! ! -[dependencies] -'. - Kernel writeFile: filename contents: contents +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +eventTableFor: anObject + ^eventHandlers at: anObject ifAbsent: nil ! ! -!LMRObject methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -size - ^self primitiveSize +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +flushNativizedSends + ImageSegment bound do: [:s | + s overriddenMethods ifNotNil: [:overridden | + overridden + do: [:m | m isNativized ifTrue: [m currentVersion prepareForExecution]]; + do: [:m | SendSite flush: m selector]]]. + SendSite flush ! ! -!Module methodsFor: 'snapshotting' stamp: 'KenD 28/Jun/2026 13:27:38'! -prepareForSnapshot: aBuilder - aBuilder - importNilToken; - addBoundary: Symbol symbolTable as: SymbolicReference symbolTable; - map: overriden to: Dictionary new +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +flushOverriddenSends + ImageSegment bound do: [:s | s flushOverriddenSends]. + SendSite flush ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -addClass: aClass - classes add: aClass. - self exportClass: aClass +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +ignoreHalts: aBoolean + Halt ignoreSignals: aBoolean. + AssertionFailure ignoreSignals: aBoolean ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -addExtension: aCompiledMethod - | collection | - collection := extensions at: aCompiledMethod classBinding symbol ifAbsentPut: [OrderedCollection new]. - collection add: aCompiledMethod. +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +ignoreOSMessagesWhile: aBlock + ^eventDispatcher isNil + ifTrue: [aBlock value] + ifFalse: [aBlock evaluateAtomically] ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -addOverride: aCompiledMethod - overriden at: aCompiledMethod signature put: aCompiledMethod +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +primitiveNamed: aString + ^NamedPrimitives at: aString ifAbsent: nil ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -bind - classes - reject: [:c | classes includes: c superclass] - thenDo: [:c | c superclass addSubclass: c]. - extensions keysAndValuesDo: [:s :methods | | meta key target | - meta := s endsWith: ' class'. - key := meta ifTrue: [(s trimTail: ' class') asSymbol] ifFalse: [s]. - target := namespace at: key ifAbsent: [self _halt]. - meta ifTrue: [target := target class]. - methods do: [:m | | current extension | - current := target compiledMethodAt: m selector. - extension := m asExtensionFor: self. - target addSelector: m selector withMethod: extension. - current notNil ifTrue: [current module addOverride: current]] - ] +!SmalltalkSystem methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +showBacktraceOf: aProcess label: aString + | writer logger | + writer := '' writeStream. + aProcess + backtraceOn: writer + maxLevels: 100 + stopWhen: [:cm | cm isDoit] + filtered: false + arguments: false. + logger := self at: #Transcript ifAbsent: nil. + logger isNil + ifTrue: [session logError: writer contents] + ifFalse: [logger nextPutAll: aString; cr; nextPutAll: writer contents]. + aProcess isResumable ifTrue: [aProcess performDeferred: #resume] ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -bind: anObject as: aSymbol - namespace at: aSymbol put: anObject. - self justDefined: aSymbol +!SmalltalkSystem methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +canOpenBacktrace + ^true ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -bindKernelExports - | bindings | - bindings := Dictionary new. - { - Object. Class. Metaclass. CompiledMethod. - Array. OrderedCollection. Set. Dictionary. - SmallInteger. String. Character. - } do: [:class | - bindings at: class symbol put: class]. - bindings at: #Kernel put: Kernel. - self bindAll: bindings +!SmalltalkSystem methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hasDebuggerTool + ^false ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -export: anObject as: aSymbol - namespace at: aSymbol put: anObject. - exports add: aSymbol +!SmalltalkSystem methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +includes: anObject + ^globals includes: anObject ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -exportClass: aClass - self export: aClass as: aClass name asSymbol +!SmalltalkSystem methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +includesKey: aSymbol + ^globals includesKey: aSymbol ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -exports - | result | - result := Dictionary new. - result at: '__module__' put: self. - exports do: [:name | | value | - value := namespace at: name. - result at: name put: value]. - ^result +!SmalltalkSystem methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isBee + ^true ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -import: moduleName - | module | - namespace at: moduleName ifPresent: [:loaded | ^loaded]. - module := Kernel load: moduleName. - self bind: module as: moduleName. - ^module +!SmalltalkSystem methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +exit + session exit ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -import: name from: moduleName - ^self import: name from: moduleName as: name +!SmalltalkSystem methodsFor: 'startup/shutdown' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +startUp + session startUp. + self ephemeronsDo: [:e | e activate]. + Float startUp. + memory startUp. + "platform startUp." ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -import: name from: moduleName as: newName - | module import | - module := Kernel load: moduleName. - import := module namespace at: name. - self bind: import as: newName +!SmalltalkSystem methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initialize + eventHandlers := WeakIdentityDictionary new. + registeredEvents := WeakIdentityDictionary new ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -importDescriptor: descriptor - | moduleName token exportNames | - moduleName := descriptor key. - token := descriptor value. - exportNames := token isArray ifTrue: [token] ifFalse: [{token}]. - exportNames do: [:name | self import: name from: moduleName] +!SmalltalkSystem methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +rehashWeakRegistries + eventHandlers rehash. + registeredEvents rehash ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -importRequiredModules - requires do: [:name | self import: name]. - self imports do: [:descriptor | self importDescriptor: descriptor] +!SmalltalkSystem methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +printOn: aStream + self == Smalltalk + ifTrue: [aStream nextPutAll: 'Smalltalk'] + ifFalse: [super printOn: aStream] +! ! + +!SmalltalkSystem methodsFor: 'updating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +renameClass: aClass to: aSymbol + | symbol token assoc | + symbol := aSymbol asSymbol. + (globals includesKey: symbol) + ifTrue: [self error: 'the global ' , symbol , ' already exists']. + token := aClass symbol. + assoc := globals associationAt: token. + globals basicRemoveKey: token ifAbsent: nil. + assoc key: symbol. + globals basicAdd: assoc. + aClass name: symbol +! ! + +!SmalltalkSystem methodsFor: 'binding libraries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +segmentLoaded: anImageSegment + ! ! -!Module methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -imports - " - Returns an array of import descriptors. A descriptor can be: - - A composite symbol (i.e #Core.Modules.Writer) (NOT IMPLEMENTED YET). - - An association of module name and exported name (i.e #Core.Modules.JSON -> #Writer) - - An association of module name, exported name and rename (i.e. #Core.Modules.JSON -> (#Writer -> #JSONWriter)) (NOT IMPLEMENTED YET) - " - ^#() +!SmalltalkSystem methodsFor: 'binding libraries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +segmentUnloaded: anImageSegment + ! ! -!Module methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! -basicInitialize - name := self defaultName. - namespace ifNil: [namespace := Namespace new]. - exports := Set new. - cachedLookups := Dictionary new. - classes := OrderedCollection new. - extensions := Dictionary new. - overriden := Dictionary new. - requires := #() +!SmalltalkSystem methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +select: aBlock thenDo: anotherBlock + globals select: aBlock thenDo: anotherBlock ! ! -!Module methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! -defaultName - | classname | - classname := self class name. - (classname endsWith: 'Module') ifTrue: [^classname trimTail: 'Module']. - (classname beginsWith: 'Module') ifTrue: [^classname trimPrefix: 'Module']. - ^classname +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +_instancesAreArrayed + ^format & Variable = Variable +! ! + +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +_instancesAreFixed + ^format & Variable = 0 ! ! -!Module methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -bindAll: aDictionary - aDictionary keysAndValuesDo: [:symbol :value | - namespace at: symbol put: value. - self justDefined: symbol]. +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +_instancesHavePointers + ^format & Pointers !!= 0 ! ! -!Module methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -justDefined: aSymbol - | lookups | - lookups := cachedLookups at: aSymbol ifAbsent: [^nil]. - lookups do: [:lookup | lookup flush] +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +canUnderstand: aSymbol + ^instanceBehavior implements: aSymbol ! ! -!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -classes - ^classes +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +includesSelector: aSymbol + ^self methodDictionary includesKey: aSymbol ! ! -!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -extensions - ^extensions +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +instancesAreArrayed + ^self _instancesAreArrayed ! ! -!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -justLoaded - self bind +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +instancesHavePointers + ^self _instancesHavePointers ! ! -!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -name - ^name +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isBytes + ^self _instancesHavePointers not ! ! -!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -name: aString - name := aString +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isCategorized + ^self organization notNil ! ! -!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -namespace - ^namespace +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isSpecies + ^true ! ! -!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -originalMethodFor: aCompiledMethod - aCompiledMethod module == self ifTrue: [^aCompiledMethod]. - ^overriden at: aCompiledMethod signature ifAbsent: nil +!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isVariable + ^self _instancesAreArrayed ! ! -!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -overriden - ^overriden +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +>> aSelector + ^self compiledMethodAt: aSelector ! ! -!Module methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -requires - ^requires +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +classVariableAssociationAt: aString + | c assoc | + c := self. + [ + c isNil ifTrue: [^nil]. + c classVariables notNil and: [ + assoc := c classVariables associationAt: aString ifAbsent: nil. + assoc notNil]] + whileFalse: [c := c superclass]. + ^assoc ! ! -!Module methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -classNamed: aString - ^classes detect: [:cls | cls name = aString ] ifNone: nil +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +classVariableString + | stream | + stream := '' writeStream. + self classVarNames asSortedCollection + do: [:cvar | stream nextPutAll: cvar] + separatedBy: [stream space]. + ^stream contents ! ! -!Module methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -extensionClasses - ^extensions keys - collect: [:s | | key | - key := (s endsWith: ' class') ifTrue: [(s trimTail: ' class') asSymbol] ifFalse: [s]. - namespace at: key ifAbsent: [Class new name: (s , '__Not_Found') asSymbol]] +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +compiledMethodAt: aSymbol + ^self methodDictionary at: aSymbol ifAbsent: nil ! ! -!Module methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isModule - ^true +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +fillFrom: aClass + | ivars | + self == aClass ifTrue: [^self]. + format := aClass format. + ivars := aClass instVarNames. + instanceVariables := ivars notEmpty ifTrue: [ivars] ! ! -!Module class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -new - ^self basicNew basicInitialize +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +format + ^format ! ! -!ArgParserModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! -imports - ^{ - #Kernel -> #(Error OrderedDictionary). - } +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +format: anInteger + format := anInteger ! ! -!CodeSpecsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:39'! -imports - ^{ - #Kernel -> #(#OrderedDictionary). - } +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +instVarNames: aCollection + instanceVariables := aCollection isEmpty + ifFalse: [ + self isBytes ifTrue: [^self error: 'byte objects cannot have named instance variables']. + aCollection asArray]. + self updateInstSize; allSubspeciesDo: [:class | class updateInstSize] ! ! -!TestsModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:41'! -imports - ^{ - #Kernel -> #(Array Error Exception OrderedCollection UndefinedObject WideString WideSymbol). - #Compiler -> #(SCompiler SCompilationError SMethodNode SSelectorNode SMessageNode SStringToken InlinedArgEnvironment MethodScope). - #SUnit -> #(TestCase TestResult TestSuite) - } +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +instanceBehavior + ^instanceBehavior ! ! -!TestsModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:41'! -main: anArray - | suite result | - Kernel log: 'Running Compiler tests... -'. - suite := TestSuite forModule: self. - Kernel log: 'suite built with ', suite tests size printString, ' tests -'. - result := suite run. - Kernel log: 'Done. -'. - Kernel log: result printString. - Kernel log: ' -' +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +methodDictionary + ^instanceBehavior methods ! ! -!CompilerModule methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026 13:27:40'! -initialize - super initialize. - TreecodeEncoder initializeBindingIds; initializeTreecodeIds. - self initializeClosureElementIds +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +selectors + ^self methodDictionary keys ! ! -!CompilerModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! -imports - ^{ - #Kernel -> #(Error ByteArray CompiledBlock Module NumberParser Species OrderedDictionary) - } +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +superclass + ^superclass ! ! -!CompilerModule methodsFor: 'class initialization' stamp: 'KenD 28/Jun/2026 13:27:40'! -initializeClosureElementIds - self namespace - at: #CaptureSelf put: 0; - at: #CaptureLocalArgument put: 1; - at: #CaptureEnvironment put: 2; - at: #CaptureEnvironmentValue put: 3; - at: #CaptureInlinedArgument put: 4 +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +superclass: aClass + superclass := aClass ! ! -!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -addCommand: aString description: aDescription action: aSymbol - | command | - command := Command new - name: aString; - description: aDescription. - command action: [:result | self perform: aSymbol with: result]. - parser addCommand: command. - ^command +!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +timestamp + ^organization notNil ifTrue: [organization timestamp] ! ! -!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -loadConfig - | host | - config := Config load. - host := Kernel host. - config modulePaths do: [:path | - host prependSearchPath: path type: #tonel. - host prependSearchPath: path type: #ems] +!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +addSelector: aSymbol withMethod: aCompiledMethod + | selector | + selector := aSymbol asSymbol. + self methodDictionary at: selector put: aCompiledMethod. + self organization notNil ifTrue: [self organization classify: selector] ! ! -!EPMModule methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:40'! -setupParser - | create | - parser := ArgParser new name: 'epm'; description: 'Egg Package Manager'. - create := self addCommand: 'new' description: 'Create a new project' action: #commandNew:. - create addPositional: 'name'. - self addCommand: 'init' description: 'Initialize epm.toml in current directory' action: #commandInit:. - self addCommand: 'start' description: 'Run current project' action: #commandStart:. - self addCommand: 'dev' description: 'Start development environment for current project' action: #commandDev:. - self addCommand: 'install' description: 'Install dependencies from epm.toml' action: #commandInstall:. - self addCommand: 'list' description: 'List project dependencies' action: #commandList:. - ((self addCommand: 'test' description: 'Run tests for a module' action: #commandTest:) - addPositional: 'module'; - addOption: (Option new - long: '--debug'; - description: 'Run tests without swallowing exceptions'; - beFlag; - yourself)) +!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeSelector: aSymbol + self methodDictionary removeKey: aSymbol ifAbsent: []. + self organization notNil ifTrue: [self organization remove: aSymbol] ! ! -!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! -commandDev: aResult - | cwd name dev module | - cwd := Kernel currentDirectory. - name := cwd copyAfterLast: $/. - dev := Kernel load: #Development. - module := Kernel load: name asSymbol. - dev main: args +!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +removeSubclass: aClass + " + do nothing + " + ! ! -!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! -commandInit: aResult - | cwd name generator | - cwd := Kernel currentDirectory. - name := cwd copyAfterLast: $/. - name isEmpty ifTrue: [name := 'myproject']. - generator := ProjectGenerator new. - generator name: name. - generator dir: cwd. - generator generateToml. - Kernel log: 'Initialized epm.toml for: ', name +!Species methodsFor: 'hierarchy' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +addSubclass: aClass + | copy | + (self subclasses includes: aClass) ifTrue: [^self]. + copy := self subclasses copyWith: aClass. + self subclasses: copy. + aClass superclass: self ! ! -!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! -commandInstall: aResult - | dependencies | - config ifNil: [self loadConfig]. - dependencies := config dependencies. - dependencies isEmpty ifTrue: [ - Kernel log: 'No dependencies to install'. - ^self]. - Kernel log: 'Installing dependencies...'. - dependencies keysAndValuesDo: [:name :constraint | - Kernel log: ' ', name, ' (', constraint asString, ')']. - Kernel log: 'Done' +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +allClassVarNames + ^(self withAllSuperclasses reversed gather: [:cls | cls classVarNames]) asArray ! ! -!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! -commandList: aResult - | dependencies | - config ifNil: [self loadConfig]. - dependencies := config dependencies. - dependencies isEmpty ifTrue: [ - Kernel log: 'No dependencies'. - ^self]. - Kernel log: config name ifNil: ['(unnamed project)']. - dependencies keysAndValuesDo: [:name :constraint | - Kernel log: ' ', name, ' ', constraint asString] +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +allInstVarNames + ^(self withAllSuperclasses reversed gather: [:class | class instVarNames]) asArray ! ! -!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! -commandNew: aResult - | name generator | - aResult positionals isEmpty ifTrue: [ - ^self error: 'Usage: epm new ']. - name := aResult positionalAt: 1. - generator := ProjectGenerator new. - generator name: name. - generator generate. - Kernel log: 'Created project: ', name +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +allSubclasses + | all | + all := OrderedCollection new. + self allSubclassesDo: [:cls | all add: cls]. + ^all ! ! -!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! -commandStart: aResult - | cwd name module | - cwd := Kernel currentDirectory. - name := cwd copyAfterLast: $/. - module := Kernel load: name asSymbol. - module main: args +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +allSubclassesDo: aBlock + self subclassesDo: [:class | + aBlock value: class. + class allSubclassesDo: aBlock] ! ! -!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! -commandTest: aResult - | name module positionals | - positionals := aResult positionals. - name := positionals isEmpty - ifTrue: [self projectName] - ifFalse: [positionals first]. - name ifNil: [ - ^self error: 'Usage: epm test [module-name]']. - module := Kernel load: (name, '.Tests') asSymbol. - (aResult optionAt: 'debug') == true - ifTrue: [self debugTestModule: module] - ifFalse: [module main: args] +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +allSubinstances + | subinstances | + subinstances := OrderedCollection new. + [ + self + withAllSubclassesDo: [:cls | subinstances + addAll: cls allExistingInstances]] + evaluateAtomically. + ^subinstances asArray ! ! -!EPMModule methodsFor: 'commands' stamp: 'KenD 28/Jun/2026 13:27:40'! -debugTestModule: aModule - Kernel log: 'Running ', aModule name, ' tests in debug mode...'; log: String cr. - (TestSuite forModule: aModule) runDebug. - Kernel log: 'Done.'; log: String cr +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +allSubspecies + | all | + all := OrderedCollection new. + self allSubspeciesDo: [:cls | all add: cls]. + ^all ! ! -!EPMModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:40'! -imports - ^{ - #Kernel -> #(Error OrderedDictionary). - #ArgParser -> #(ArgParser Command Option). - #SUnit -> #(TestSuite). - #TOML -> #(TOMLParser TOMLWriter). - } +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +allSubspeciesDo: aBlock + self subspeciesDo: [:class | + aBlock value: class. + class allSubspeciesDo: aBlock] ! ! -!EPMModule methodsFor: 'main' stamp: 'KenD 28/Jun/2026 13:27:40'! -main: aCollection - | params | - args := aCollection. - self loadConfig. - self setupParser. - params := OrderedCollection new. - 3 to: args size do: [:i | - | arg | - arg := args at: i. - params add: arg]. - parser parse: params asArray +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +allSuperclasses + | superclasses | + superclasses := OrderedCollection new. + self allSuperclassesDo: [:s | superclasses add: s]. + ^superclasses ! ! -!EPMModule methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:40'! -projectName - ^config ifNotNil: [config name] +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +allSuperclassesDo: aBlock + superclass isNil ifTrue: [^self]. + aBlock value: superclass. + superclass allSuperclassesDo: aBlock ! ! -!LMRModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:38'! -imports - ^{ - #Kernel -> #(ArrayedCollection CharacterArray Closure Float ProtoObject Species Symbol) - } +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +methodsReadingInstVar: aString + | methods index | + methods := OrderedCollection new. + index := self indexOfSlot: aString. + index = 0 ifTrue: [^methods]. + self methodDictionary + select: [:cm | cm usesInstanceVariable: index] + thenDo: [:cm | methods add: cm]. + ^methods ! ! -!ModuleImporterModule methodsFor: 'spec' stamp: 'KenD 28/Jun/2026 13:27:37'! -imports - ^{ - #Kernel -> #(#InternalReadStream #Character #CharacterArray #IdentitySet #Module). - #Tonel -> #(#TonelReader). - #CodeSpecs -> #(#ModuleSpec #ClassSpec #MetaclassSpec #MethodSpec). - #STON -> #(#STONReader). - #Compiler -> #(#SCompiler). - } +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +methodsReferencingClassVar: aString + | methods assoc | + methods := OrderedCollection new. + assoc := self classVariableAssociationAt: aString. + assoc isNil ifTrue: [^methods]. + self instanceClass methodDictionary + & self instanceClass class methodDictionary + select: [:cm | cm referencesAssociation: assoc] + thenDo: [:cm | methods add: cm]. + ^methods ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -checkNumberEnd: position - | char | - stream atEnd ifTrue: [^self]. - char := stream peek. - char = $. ifFalse: [^self]. - stream skip: 1. - stream atEnd - ifFalse: [stream peek isDigit - ifTrue: [self error: 'invalid number' at: position]]. - stream skip: -1 +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +methodsReferencingInstVar: aString + | methods index | + methods := OrderedCollection new. + index := self indexOfSlot: aString. + index = 0 ifTrue: [^methods]. + self methodDictionary + select: [:cm | cm referencesInstanceVariable: index] + thenDo: [:cm | methods add: cm]. + ^methods ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -completeFloat: anInteger - | tenth | - tenth := 10 raisedToInteger: self nextExponent. - ^(anInteger * tenth) asFloat +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +methodsWritingInstVar: aString + | methods index | + methods := OrderedCollection new. + index := self indexOfSlot: aString. + index = 0 ifTrue: [^methods]. + self methodDictionary + select: [:cm | cm assignsInstanceVariable: index] + thenDo: [:cm | methods add: cm]. + ^methods ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -completeNumber: anInteger after: aCharacter - aCharacter = $. ifTrue: [ - ^(stream peekFor: $s) - ifTrue: [self nextScaledFrom: anInteger fractionDigits: 0] - ifFalse: [self nextFloat: anInteger]]. - (aCharacter = $e or: [aCharacter = $E]) - ifTrue: [^self completeFloat: anInteger]. - aCharacter = $r ifTrue: [^self nextIntegerRadix: anInteger]. - aCharacter = $s ifTrue: [^self nextScaledFrom: anInteger fractionDigits: 0]. - (anInteger = 0 and: [aCharacter = $x or: [aCharacter = $X]]) - ifTrue: [^self nextIntegerRadix: 16]. - stream skip: -1. - ^anInteger +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +selectorsInCategory: aSymbol + ^self organization selectorsFor: aSymbol ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -completeNumber: anInteger at: start - | number | - stream atEnd ifTrue: [^anInteger]. - number := anInteger. - number := self completeNumber: anInteger after: stream next. - self checkNumberEnd: start. - ^number +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +withAllSubclasses + ^OrderedCollection with: self withAll: self allSubclasses ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -digitFromChar: char base: radix - | c | - char isDigit ifTrue: [^char digitValue]. - char = $r ifTrue: [^nil]. - char = $x ifTrue: [^nil]. - char = $X ifTrue: [^nil]. - c := char asUppercase. - (c asInteger between: $A asInteger and: $Z asInteger) ifFalse: [^nil]. - (c !!= $E and: [radix <= c digitValue]) ifTrue: [^nil]. - (c = $E and: [radix = 10]) ifTrue: [^nil]. - ^c digitValue +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +withAllSubspecies + ^OrderedCollection with: self withAll: self allSubspecies ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -endToken - self error: 'end of stream' at: stream position +!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +withAllSuperclasses + ^OrderedCollection with: self withAll: self allSuperclasses ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -error: aString at: position - error := aString -> position. - return value: nil +!Species methodsFor: 'instances' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +allInstances + ^Kernel memory allInstancesOf: self ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -negativeNumber - | position | - stream atEnd ifTrue: [^nil]. - stream peek isDigit ifFalse: [^nil]. - position := stream position. - ^self next key negated -> position +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicNew + ^self errorVMSpecific ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -next - | char | - return isNil ifTrue: [return := [:value | ^value]]. - char := self nextChar. - char isNil ifTrue: [^self endToken]. - char = $- ifTrue: [^self negativeNumber]. - char = $+ ifTrue: [^self positiveNumber]. - char isDigit ifTrue: [^self nextNumber: char]. - ^nil +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +basicNew: anInteger + ^self errorVMSpecific ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -nextChar - ^stream skipWhitespace atEnd ifFalse: [stream next] +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new + ^self errorVMSpecific ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -nextDigit: radix - | char digit | - stream atEnd ifTrue: [^nil]. - char := stream next. - digit := self digitFromChar: char base: radix. - digit isNil ifTrue: [ - stream skip: -1. - ^nil]. - radix <= digit - ifTrue: [self error: 'digit greater than radix' at: stream position]. - ^digit +!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +new: anInteger + ^self errorVMSpecific ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -nextExponent - | negated exp | - negated := false. - (stream peekFor: $+) ifFalse: [negated := stream peekFor: $-]. - exp := self nextIntegerRadix: 10. - negated ifTrue: [exp := exp negated]. - ^exp +!Species methodsFor: 'flags' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +bePointers + format := Pointers + self instSize ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -nextFloat: aNumber - | base digit e exp | - digit := self nextDigit: 10. - digit isNil ifTrue: [ - stream skip: -1. - ^aNumber]. - e := 1. - base := aNumber * 10 + digit. - [ - digit := self nextDigit: 10. - digit isNil] - whileFalse: [ - base := base * 10 + digit. - e := e + 1]. - ((stream peekFor: $E) or: [stream peekFor: $e]) ifTrue: [ - exp := self nextExponent. - ^(base * (10 raisedToInteger: exp - e)) asFloat]. - (stream peekFor: $s) ifTrue: [^self nextScaledFrom: base fractionDigits: e]. - ^(base * (10 raisedToInteger: e negated)) asFloat +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +browse + Smalltalk browsingTools browse: self ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -nextIntegerRadix: radix - | value valid digit | - value := 0. - valid := false. - [ - digit := self nextDigit: radix. - digit isNil] - whileFalse: [ - valid := true. - value := value * radix + digit]. - valid ifFalse: [self error: 'digit missing' at: stream position + 1]. - ^value +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +buildBehavior + | behavior | + behavior := Behavior with: self methodDictionary copy. + superclass ifNotNil: [behavior next: superclass instanceBehavior]. + instanceBehavior := behavior ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -nextNumber: aCharacter - | start number digit | - start := stream position. - number := aCharacter digitValue. - [ - digit := self nextDigit: 10. - digit isNil] - whileFalse: [number := number * 10 + digit]. - number := self completeNumber: number at: start. - ^number -> (start thru: stream position) +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +instVarNames + instanceVariables isNil ifTrue: [^#()]. + instanceVariables isArray ifTrue: [^instanceVariables]. + ^instanceVariables substrings ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -nextScaledFrom: aNumber fractionDigits: digits - | scale denominator sd | - scale := (stream atEnd not and: [stream peek isDigit]) - ifTrue: [self nextIntegerRadix: 10]. - denominator := 10 raisedToInteger: digits. - sd := ScaledDecimal - numerator: aNumber - denominator: denominator - scale: scale. - ^sd reduced +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +instanceVariableString + ^String streamContents: [:strm | + self instVarNames + do: [:ivar | strm nextPutAll: ivar] + separatedBy: [strm space]] ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -positiveNumber - | position | - stream peek isDigit ifFalse: [^nil]. - position := stream position. - ^self next key -> position +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +kindOfSubclass + self _instancesAreFixed ifTrue: [^'subclass:']. + self isBytes ifTrue: [^'variableByteSubclass:']. + self _instancesHavePointers ifTrue: [^'variableSubclass:']. + self error: 'invalid type of subclass' ! ! -!NumberParser methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -reset - stream reset. - return := nil +!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +updateClassifications + organization notNil ifTrue: [organization updateOn: self] ! ! -!NumberParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -error - ^error +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +categories + ^self organization notNil + ifTrue: [self organization categoriesOn: self] + ifFalse: [#()] ! ! -!NumberParser methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -on: aString - stream := aString readStream. - return := nil +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +categorizedSelectors + ^self organization notNil + ifTrue: [self organization allSelectors] + ifFalse: [#()] ! ! -!NumberParser methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -nextValue - ^self next ifNil: [0] ifNotNil: [:assoc | assoc key] +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +hasUnclassifiedSelectors + ^self categorizedSelectors size < self methodDictionary size ! ! -!ObjectReference methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! -beAbsolute - absolute := true +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +organization + organization isNil ifTrue: [self initializeOrganization]. + ^organization ! ! -!ObjectReference methodsFor: 'actions' stamp: 'KenD 28/Jun/2026 13:27:38'! -classBinding - ^source classBinding +!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +organization: aClassOrganizer + organization := aClassOrganizer ! ! -!ObjectReference methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -for: anObject - self target: anObject +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +categoryFor: selector + | category | + self organization notNil ifTrue: [ + category := self organization categoryFor: selector. + category notNil ifTrue: [^category]]. + ^ClassOrganizer default ! ! -!ObjectReference methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! -initialize - absolute := false +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +classImplementing: aSymbol + (self methodDictionary includesKey: aSymbol) ifTrue: [^self]. + ^self allSuperclasses + detect: [:class | class includesSelector: aSymbol] + ifNone: [] ! ! -!ObjectReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isAbsolute - ^absolute +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +depth + " + Object depth + SmallInteger depth 4 + " + | depth ancestor | + depth := 0. + ancestor := self superclass. + ancestor notNil ifTrue: [depth := ancestor depth + 1]. + ^depth ! ! -!ObjectReference methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isMethod +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +inheritsFrom: aClass + | class | + class := self. + [class == nil] whileFalse: [ + class == aClass ifTrue: [^true]. + class := class superclass]. ^false ! ! -!ObjectReference methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! -printOn: aStream - aStream nextPutAll: 'Ref to ' , target printString +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +instSize + ^format & 16r7F ! ! -!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -source: sourceObject - source := sourceObject +!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +shouldBeHidden: aSymbol + ^false ! ! -!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -sourceOffset - ^sourceOffset +!Species methodsFor: 'copying' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +deepCopy + ^self ! ! -!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -sourceOffset: aNumber - sourceOffset := aNumber +!Species methodsFor: 'copying' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +shallowCopy + ^self ! ! -!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -target - ^target +!Species methodsFor: 'errors' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +errorNotIndexable + ^self error: 'Instances of ' , self name , ' are not indexable' ! ! -!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -target: anObject - target := anObject +!Species methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initializeOrganization + self + organization: (ClassOrganizer new classifyAll: self selectors under: nil) ! ! -!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -targetOffset - ^0 +!Species methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +instanceBehavior: aBehavior + instanceBehavior := aBehavior ! ! -!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -valueToWriteAt: sourceAddress with: wordSize - ^self - valueToWriteAt: sourceAddress - targeting: target _asSmallInteger - with: wordSize +!Species methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +updateInstSize + | size | + size := superclass isNil ifTrue: [0] ifFalse: [superclass instSize]. + format := format - self instSize + size + self instVarNames size ! ! -!ObjectReference methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -valueToWriteWith: wordSize - ^self valueToWriteAt: source _asSmallInteger + sourceOffset with: wordSize +!Species methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +primitiveNewBytes: size + ^self errorVMSpecific ! ! -!ObjectReference methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026 13:27:38'! -valueToWriteAt: sourceAddress targeting: targetAddress with: wordSize - | address correction | - address := targetAddress + self targetOffset. - correction := absolute - ifTrue: [0] - ifFalse: [sourceAddress + sourceOffset + wordSize]. - ^address - correction +!Species methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +printOn: aStream + aStream nextPutAll: self name ! ! -!ObjectReference class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -absoluteFor: anObject - ^(self new for: anObject) beAbsolute +!Species methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +withAllSubclassesDo: aBlock + aBlock evaluateWith: self. + self allSubclassesDo: aBlock ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -_instancesAreArrayed - ^format & Variable = Variable +!Species methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +withAllSuperclassesDo: aBlock + aBlock evaluateWith: self. + self allSuperclassesDo: aBlock ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -_instancesAreFixed - ^format & Variable = 0 +!Species class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initializeFormatFlags + Flags := self addNamespace. + Flags + at: #Variable put: 16r2000; + at: #Pointers put: 16r4000 ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -_instancesHavePointers - ^format & Pointers !!= 0 +!Species class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +maxInstVarCount + ^16r7F ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -canUnderstand: aSymbol - ^instanceBehavior implements: aSymbol +!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchFirstAfterStartOn: aMatchAlgorithm + aMatchAlgorithm matchFirstStar ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -includesSelector: aSymbol - ^self methodDictionary includesKey: aSymbol +!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchFirstOn: aMatchAlgorithm + aMatchAlgorithm matchFirstStar ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -instancesAreArrayed - ^self _instancesAreArrayed +!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matchLastOn: aMatchAlgorithm + " + do nothing + " + ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -instancesHavePointers - ^self _instancesHavePointers +!StarToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +printOn: aStream + aStream nextPut: $* ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isBytes - ^self _instancesHavePointers not +!StarToken class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +current + ^current ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isCategorized - ^self organization notNil +!StarToken class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initializeCurrent + current := self new ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isSpecies - ^true +!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +addStar + stream atEnd ifTrue: [^self]. + tokens add: StarToken current. + stream next. + [stream peek ifNil: [^self] ifNotNil: [:c | c isAsterisk]] + whileTrue: [stream next] ! ! -!Species methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isVariable - ^self _instancesAreArrayed +!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +addToken + | star pos end token | + star := false. + pos := stream position + 1. + [stream atEnd or: [star := stream next isAsterisk]] whileFalse. + star ifTrue: [stream skip: -1]. + end := stream position. + pos <= end ifTrue: [ + token := MatchToken on: stream collection from: pos to: end. + tokens add: token] ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! ->> aSelector - ^self compiledMethodAt: aSelector +!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +scan + [stream atEnd] whileFalse: [self addToken; addStar] ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -classVariableAssociationAt: aString - | c assoc | - c := self. - [ - c isNil ifTrue: [^nil]. - c classVariables notNil and: [ - assoc := c classVariables associationAt: aString ifAbsent: nil. - assoc notNil]] - whileFalse: [c := c superclass]. - ^assoc +!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +input + ^stream contents ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -classVariableString - | stream | - stream := '' writeStream. - self classVarNames asSortedCollection - do: [:cvar | stream nextPutAll: cvar] - separatedBy: [stream space]. - ^stream contents +!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +on: aString + stream := aString readStream. + tokens := OrderedCollection new. + self scan ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -compiledMethodAt: aSymbol - ^self methodDictionary at: aSymbol ifAbsent: nil +!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +tokens + ^tokens copy ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -fillFrom: aClass - | ivars | - self == aClass ifTrue: [^self]. - format := aClass format. - ivars := aClass instVarNames. - instanceVariables := ivars notEmpty ifTrue: [ivars] +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +match: aString + ^self match: aString index: 1 ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -format - ^format +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +match: aString ifAbsent: aBlock + ^self match: aString index: 1 ifAbsent: aBlock ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -format: anInteger - format := anInteger +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +match: aString index: anInteger + ^self match: aString index: anInteger ifAbsent: nil ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -instVarNames: aCollection - instanceVariables := aCollection isEmpty - ifFalse: [ - self isBytes ifTrue: [^self error: 'byte objects cannot have named instance variables']. - aCollection asArray]. - self updateInstSize; allSubspeciesDo: [:class | class updateInstSize] +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +match: aString index: anInteger ifAbsent: aBlock + | algorithm | + algorithm := MatchAlgorithm new + pattern: self; + string: aString; + index: anInteger. + algorithm run. + algorithm hasMatched ifTrue: [^algorithm matchRange]. + ^aBlock notNil ifTrue: [ + aBlock arity = 0 + ifTrue: [aBlock value] + ifFalse: [aBlock evaluateWith: algorithm failure]] ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -instanceBehavior - ^instanceBehavior +!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +matches: aString + | range | + range := self match: aString. + ^range notNil and: [range x = 1 and: [range y = aString size]] ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -methodDictionary - ^instanceBehavior methods +!StringPattern methodsFor: 'printing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +printOn: aStream + tokens do: [:t | t printOn: aStream] ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -selectors - ^self methodDictionary keys +!StringPattern class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +on: aString + ^self new on: aString ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -superclass - ^superclass +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +characterIndexOf: aString at: anInteger + | index s | + index := 0. + s := 0. + [s < anInteger] whileTrue: [| ch len | + index := index + 1. + ch := aString at: index. + len := self sizeOfCharacter: ch. + s := s + len]. + ^index ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -superclass: aClass - superclass := aClass +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decodeStringFrom: aStream + ^self + decodeStringFrom: aStream + length: aStream size // self minBytesPerChar ! ! -!Species methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -timestamp - ^organization notNil ifTrue: [organization timestamp] +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decodeStringFrom: aStream length: anInteger + | string | + string := String new: anInteger. + ^self decodeStringFrom: aStream on: string ! ! -!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:38'! -addSelector: aSymbol withMethod: aCompiledMethod - | selector | - selector := aSymbol asSymbol. - self methodDictionary at: selector put: aCompiledMethod. - self organization notNil ifTrue: [self organization classify: selector] +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decodeStringFrom: aStream on: buffer + | bytes code string index n | + bytes := true. + index := 0. + code := nil. + string := buffer. + n := string size. + [aStream atEnd or: [code = 0] or: [index >= n]] whileFalse: [ + code := self decodeFrom: aStream. + (bytes andNot: [Ansi isAnsi: code]) ifTrue: [ + bytes := false. + string := string asWideString]. + code = 0 ifFalse: [ + index := index + 1. + string at: index putCode: code]]. + ^index < string size ifTrue: [string copyTo: index] ifFalse: [string] ! ! -!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:38'! -removeSelector: aSymbol - self methodDictionary removeKey: aSymbol ifAbsent: []. - self organization notNil ifTrue: [self organization remove: aSymbol] +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +externalCopyOf: aString + | bytes | + aString isNil ifTrue: [^nil]. + bytes := self parameterFrom: aString. + ^bytes externalCopy ! ! -!Species methodsFor: 'add/remove' stamp: 'KenD 28/Jun/2026 13:27:38'! -removeSubclass: aClass +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexesOf: aString from: start to: end " - do nothing + UTF16 current indexesOf: (WideString with: $𝑎 with: $_ with: $𝑎 with: $→) from: 2 to: 3 " - -! ! - -!Species methodsFor: 'hierarchy' stamp: 'KenD 28/Jun/2026 13:27:38'! -addSubclass: aClass - | copy | - (self subclasses includes: aClass) ifTrue: [^self]. - copy := self subclasses copyWith: aClass. - self subclasses: copy. - aClass superclass: self + | s e | + s := 1. + 1 to: start - 1 do: [:i | | ch len | + ch := aString at: i. + len := self sizeOfCharacter: ch. + s := s + len]. + e := s - 1. + start to: end do: [:i | | ch len | + ch := aString at: i. + len := self sizeOfCharacter: ch. + e := e + len]. + ^s thru: e ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -allClassVarNames - ^(self withAllSuperclasses reversed gather: [:cls | cls classVarNames]) asArray +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isString: s1 greaterThan: s2 + ^(self compareStringiW: s1 with: s2) > 0 ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -allInstVarNames - ^(self withAllSuperclasses reversed gather: [:class | class instVarNames]) asArray +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isString: s1 greaterThanOrEqualTo: s2 + ^(self compareStringiW: s1 with: s2) >= 0 ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -allSubclasses - | all | - all := OrderedCollection new. - self allSubclassesDo: [:cls | all add: cls]. - ^all +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isString: s1 lessThan: s2 + ^(self compareStringiW: s1 with: s2) < 0 ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -allSubclassesDo: aBlock - self subclassesDo: [:class | - aBlock value: class. - class allSubclassesDo: aBlock] +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isString: s1 lessThanOrEqualTo: s2 + ^(self compareStringiW: s1 with: s2) <= 0 ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -allSubinstances - | subinstances | - subinstances := OrderedCollection new. - [ - self - withAllSubclassesDo: [:cls | subinstances - addAll: cls allExistingInstances]] - evaluateAtomically. - ^subinstances asArray +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +lowercaseOf: aString + ^UTF16 current lowercaseOf: aString ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -allSubspecies - | all | - all := OrderedCollection new. - self allSubspeciesDo: [:cls | all add: cls]. - ^all +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sizeInBytesOf: aString + | size | + size := self sizeOfCharacter: Character null. + 1 to: aString size do: [:i | | ch s | + ch := aString at: i. + s := self sizeOfCharacter: ch. + size := size + s]. + ^size ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -allSubspeciesDo: aBlock - self subspeciesDo: [:class | - aBlock value: class. - class allSubspeciesDo: aBlock] +!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +uppercaseOf: aString + ^UTF16 current uppercaseOf: aString ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -allSuperclasses - | superclasses | - superclasses := OrderedCollection new. - self allSuperclassesDo: [:s | superclasses add: s]. - ^superclasses +!Unicode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +compareStringiW: aString1 with: aString2 + ^UTF16 current compareStringiW: aString1 with: aString2 ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -allSuperclassesDo: aBlock - superclass isNil ifTrue: [^self]. - aBlock value: superclass. - superclass allSuperclassesDo: aBlock +!Unicode methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +minBytesPerChar + ^1 ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -methodsReadingInstVar: aString - | methods index | - methods := OrderedCollection new. - index := self indexOfSlot: aString. - index = 0 ifTrue: [^methods]. - self methodDictionary - select: [:cm | cm usesInstanceVariable: index] - thenDo: [:cm | methods add: cm]. - ^methods +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decode: aByteArray + ^self decodeStringFrom: aByteArray readStream ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -methodsReferencingClassVar: aString - | methods assoc | - methods := OrderedCollection new. - assoc := self classVariableAssociationAt: aString. - assoc isNil ifTrue: [^methods]. - self instanceClass methodDictionary - & self instanceClass class methodDictionary - select: [:cm | cm referencesAssociation: assoc] - thenDo: [:cm | methods add: cm]. - ^methods +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decodeFrom: aStream + self subclassResponsibility ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -methodsReferencingInstVar: aString - | methods index | - methods := OrderedCollection new. - index := self indexOfSlot: aString. - index = 0 ifTrue: [^methods]. - self methodDictionary - select: [:cm | cm referencesInstanceVariable: index] - thenDo: [:cm | methods add: cm]. - ^methods +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +encode: aString + ^ByteArray + streamContents: [:strm | aString do: [:ch | self encode: ch on: strm]] ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -methodsWritingInstVar: aString - | methods index | - methods := OrderedCollection new. - index := self indexOfSlot: aString. - index = 0 ifTrue: [^methods]. - self methodDictionary - select: [:cm | cm assignsInstanceVariable: index] - thenDo: [:cm | methods add: cm]. - ^methods +!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +encode: aCharacter on: aStream + self subclassResponsibility ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -selectorsInCategory: aSymbol - ^self organization selectorsFor: aSymbol +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decode: aByteArray + ^self current decode: aByteArray ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -withAllSubclasses - ^OrderedCollection with: self withAll: self allSubclasses +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decodeBytes: aByteArray + | decoder stream | + stream := aByteArray readStream. + decoder := self decoderFor: stream. + ^decoder decode: stream upToEnd ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -withAllSubspecies - ^OrderedCollection with: self withAll: self allSubspecies +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decodeFromAddress: externalAddress length: anInteger + ^self current + decodeStringFrom: externalAddress readStream + length: anInteger ! ! -!Species methodsFor: 'queries' stamp: 'KenD 28/Jun/2026 13:27:38'! -withAllSuperclasses - ^OrderedCollection with: self withAll: self allSuperclasses +!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decoderFor: aStream + (aStream peekForAll: UTF32 prefix) ifTrue: [^UTF32]. + (aStream peekForAll: UTF16 prefix) ifTrue: [^UTF16]. + ^UTF8 ! ! -!Species methodsFor: 'instances' stamp: 'KenD 28/Jun/2026 13:27:38'! -allInstances - ^Kernel memory allInstancesOf: self +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +characterIndexOf: aString at: anInteger + (self isDBS: aString upTo: anInteger - 1) ifTrue: [^anInteger]. + ^super characterIndexOf: aString at: anInteger * 2 ! ! -!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -basicNew - ^self errorVMSpecific +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +characterIndexesOf: aString from: start to: end + " + UTF16 current characterIndexesOf: '𝑎𝑎𝑎x' from: 3 to: 5 + " + | i e s max n | + aString isWideString ifFalse: [^start thru: end]. + s := i := self characterIndexOf: aString at: start. + n := aString size. + max := end * 2. + e := start * 2. + [i < n and: [e <= max]] whileTrue: [| ch len | + i := i + 1. + ch := aString at: i. + len := self sizeOfCharacter: ch. + e := e + len]. + ^s thru: i - 1 ! ! -!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -basicNew: anInteger - ^self errorVMSpecific +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +indexesOf: aString from: start to: end + | e stretch delta | + e := start - 1 max: end - 1. + (self isDBS: aString upTo: e) ifTrue: [ + delta := end > 0 + ifTrue: [self sizeOfCharacter: (aString at: end)] + ifFalse: [0]. + ^start thru: end - 1 + (delta // 2)]. + stretch := super indexesOf: aString from: start to: end. + ^stretch + 1 // 2 ! ! -!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -new - ^self errorVMSpecific +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isDBS: aString + ^self isDBS: aString upTo: aString size ! ! -!Species methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -new: anInteger - ^self errorVMSpecific +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +isDBS: aString upTo: anInteger + aString isWide ifFalse: [^true]. + 2 + to: anInteger * 4 + by: 4 + do: [:i | (aString uShortAtOffset: i) = 0 ifFalse: [^false]]. + ^true ! ! -!Species methodsFor: 'flags' stamp: 'KenD 28/Jun/2026 13:27:38'! -bePointers - format := Pointers + self instSize +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +lengthOf: aString + ^(self encode: aString) size // 2 ! ! -!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -browse - Smalltalk browsingTools browse: self +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +parameterFrom: aString + | strm | + strm := (ByteArray new: aString size + 1 * 2) writeStream. + aString isCharacter + ifTrue: [self encode: aString on: strm] + ifFalse: [aString do: [:char | self encode: char on: strm]]. + strm nextPut: 0; nextPut: 0. + ^strm contents ! ! -!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -buildBehavior - | behavior | - behavior := Behavior with: self methodDictionary copy. - superclass ifNotNil: [behavior next: superclass instanceBehavior]. - instanceBehavior := behavior +!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sizeInBytesOf: aString + aString isWideString ifFalse: [^aString size + 1 * 2]. + ^super sizeInBytesOf: aString ! ! -!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -instVarNames - instanceVariables isNil ifTrue: [^#()]. - instanceVariables isArray ifTrue: [^instanceVariables]. - ^instanceVariables substrings +!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decodeFrom: aStream + | b1 b2 hi b3 b4 lo | + b1 := aStream nextByte. + b2 := aStream nextByte. + hi := b1 + (b2 bitShift: 8). + b2 < 16rD8 ifTrue: [^hi]. + hi := hi - 16rD800. + hi < 16r400 ifFalse: [^b2 * 256 + b1]. + hi := (hi bitShift: 10) + 16r10000. + b3 := aStream nextByte. + b4 := aStream nextByte. + lo := (b4 bitShift: 8) - 16rDC00 + b3. + ^hi + lo ! ! -!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -instanceVariableString - ^String streamContents: [:strm | - self instVarNames - do: [:ivar | strm nextPutAll: ivar] - separatedBy: [strm space]] +!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +encode: aCharacter on: aStream + | code c20 hi lo | + code := aCharacter codePoint. + code < 128 ifTrue: [ + aStream nextPut: code; nextPut: 0. + ^self]. + code < 16rD800 ifTrue: [ + aStream + nextPut: (code bitAnd: 16rFF); + nextPut: (code bitShift: -8). + ^self]. + code < 16rE000 ifTrue: [self error: 'invalid code point']. + code < 16r10000 ifTrue: [ + aStream + nextPut: (code bitAnd: 16rFF); + nextPut: (code bitShift: -8). + ^self]. + code < 16r110000 ifTrue: [ + c20 := code - 16r10000. + hi := (c20 bitShift: -10) + 16rD800. + lo := (c20 bitAnd: 16r3FF) + 16rDC00. + aStream + nextPut: (hi bitAnd: 16rFF); + nextPut: (hi bitShift: -8); + nextPut: (lo bitAnd: 16rFF); + nextPut: (lo bitShift: -8). + ^self]. + self error: 'invalid code point' ! ! -!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -kindOfSubclass - self _instancesAreFixed ifTrue: [^'subclass:']. - self isBytes ifTrue: [^'variableByteSubclass:']. - self _instancesHavePointers ifTrue: [^'variableSubclass:']. - self error: 'invalid type of subclass' +!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sizeOfCharacter: aCharacter + ^aCharacter codePoint < 16r10000 ifTrue: [2] ifFalse: [4] ! ! -!Species methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -updateClassifications - organization notNil ifTrue: [organization updateOn: self] +!UTF16 methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +minBytesPerChar + ^2 ! ! -!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! -categories - ^self organization notNil - ifTrue: [self organization categoriesOn: self] - ifFalse: [#()] +!UTF16 class methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decodeFromAddress: externalAddress length: anInteger + | stream | + stream := externalAddress readStream readLimit: anInteger * 2. + ^self current decodeStringFrom: stream length: anInteger ! ! -!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! -categorizedSelectors - ^self organization notNil - ifTrue: [self organization allSelectors] - ifFalse: [#()] +!UTF16 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +prefix + ^#[16rFE 16rFF] ! ! -!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! -hasUnclassifiedSelectors - ^self categorizedSelectors size < self methodDictionary size +!UTF32 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decode: aByteArray + ^WideString newFrom: aByteArray ! ! -!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! -organization - organization isNil ifTrue: [self initializeOrganization]. - ^organization +!UTF32 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +encode: aCharacter on: aStream + aStream nextULongPut: aCharacter codePoint ! ! -!Species methodsFor: 'organization' stamp: 'KenD 28/Jun/2026 13:27:38'! -organization: aClassOrganizer - organization := aClassOrganizer +!UTF32 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +prefix + ^#[16rFE 16rFF 0 0] ! ! -!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -categoryFor: selector - | category | - self organization notNil ifTrue: [ - category := self organization categoryFor: selector. - category notNil ifTrue: [^category]]. - ^ClassOrganizer default +!UTF8 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +accepts: aByteArray + | stream | + stream := aByteArray readStream. + [stream atEnd] whileFalse: [| s | + s := self sizeOfEncoding: stream next. + s = 0 ifTrue: [^false]. + s - 1 timesRepeat: [ + stream atEnd ifTrue: [^false]. + (stream next bitAnd: 0xC0) = 0x80 ifFalse: [^false]]]. + ^true ! ! -!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -classImplementing: aSymbol - (self methodDictionary includesKey: aSymbol) ifTrue: [^self]. - ^self allSuperclasses - detect: [:class | class includesSelector: aSymbol] - ifNone: [] +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decode: aByteArray + aByteArray isExternalMemory + ifTrue: [^self class decodeMemory: aByteArray length: aByteArray length]. + 1 + to: aByteArray size + do: [:i | (aByteArray at: i) asInteger > 127 + ifTrue: [^super decode: aByteArray]]. + ^aByteArray asString ! ! -!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -depth - " - Object depth - SmallInteger depth 4 - " - | depth ancestor | - depth := 0. - ancestor := self superclass. - ancestor notNil ifTrue: [depth := ancestor depth + 1]. - ^depth +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decodeFrom: aStream + | b1 flags count bytes b2 b3 b4 | + b1 := aStream nextByte. + b1 < 128 ifTrue: [^b1]. + flags := b1 bitAnd: 16rF8. + count := self trailing: flags. + count isNil ifTrue: [^b1]. + bytes := aStream peek: count. + bytes size < count ifTrue: [^b1]. + 1 + to: count + do: [:i | ((bytes byteAt: i) bitAnd: 16rC0) = 16r80 ifFalse: [^b1]]. + aStream skip: count. + count = 1 ifTrue: [ + b2 := bytes byteAt: 1. + b1 := b1 bitAnd: 16r1F. + ^(b1 bitShift: 6) + (b2 bitAnd: 16r3F)]. + count = 2 ifTrue: [ + b2 := (bytes byteAt: 1) bitAnd: 16r3F. + b3 := (bytes byteAt: 2) bitAnd: 16r3F. + b1 := b1 bitAnd: 16rF. + ^(b1 bitShift: 12) + (b2 bitShift: 6) + b3]. + b2 := (bytes byteAt: 1) bitAnd: 16r3F. + b3 := (bytes byteAt: 2) bitAnd: 16r3F. + b4 := (bytes byteAt: 3) bitAnd: 16r3F. + b1 := b1 bitAnd: 7. + ^(b1 bitShift: 18) + (b2 bitShift: 12) + (b3 bitShift: 6) + b4 ! ! -!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -inheritsFrom: aClass - | class | - class := self. - [class == nil] whileFalse: [ - class == aClass ifTrue: [^true]. - class := class superclass]. - ^false +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +encode: aString + aString class = String ifTrue: [ + 1 + to: aString size + do: [:i | (aString codeAt: i) < 128 ifFalse: [^super encode: aString]]. + ^aString asByteArray]. + ^super encode: aString ! ! -!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -instSize - ^format & 16r7F +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +encode: aCharacter on: aStream + | code b1 b2 b3 b4 | + code := aCharacter codePoint. + code < 128 ifTrue: [ + aStream nextBytePut: code. + ^self]. + code < 16r800 ifTrue: [ + b1 := code bitShift: -6. + b1 := b1 bitOr: 16rC0. + b2 := code bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + aStream nextBytePut: b1; nextBytePut: b2. + ^self]. + code < 16r10000 ifTrue: [ + b1 := code bitShift: -12. + b1 := b1 bitOr: 16rE0. + b2 := code bitShift: -6. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + aStream + nextBytePut: b1; + nextBytePut: b2; + nextBytePut: b3. + ^self]. + b1 := code bitShift: -18. + b1 := b1 bitOr: 16rF0. + b2 := code bitShift: -12. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitShift: -6. + b3 := b3 bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + b4 := code bitAnd: 16r3F. + b4 := b4 bitOr: 16r80. + aStream + nextBytePut: b1; + nextBytePut: b2; + nextBytePut: b3; + nextBytePut: b4 ! ! -!Species methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -shouldBeHidden: aSymbol - ^false +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +encodeCharacter: aCharacter + | code b1 b2 b3 b4 | + code := aCharacter codePoint. + code < 128 ifTrue: [^ByteArray with: code]. + code < 16r800 ifTrue: [ + b1 := code bitShift: -6. + b1 := b1 bitOr: 16rC0. + b2 := code bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + ^ByteArray with: b1 with: b2]. + code < 16r10000 ifTrue: [ + b1 := code bitShift: -12. + b1 := b1 bitOr: 16rE0. + b2 := code bitShift: -6. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + ^ByteArray with: b1 with: b2 with: b3]. + b1 := code bitShift: -18. + b1 := b1 bitOr: 16rF0. + b2 := code bitShift: -12. + b2 := b2 bitAnd: 16r3F. + b2 := b2 bitOr: 16r80. + b3 := code bitShift: -6. + b3 := b3 bitAnd: 16r3F. + b3 := b3 bitOr: 16r80. + b4 := code bitAnd: 16r3F. + b4 := b4 bitOr: 16r80. + ^ByteArray with: b1 with: b2 with: b3 with: b4 ! ! -!Species methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! -deepCopy - ^self +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sizeOfCharacter: aCharacter + | code | + code := aCharacter codePoint. + code < 128 ifTrue: [^1]. + code < 16r800 ifTrue: [^2]. + code < 16r10000 ifTrue: [^3]. + ^4 ! ! -!Species methodsFor: 'copying' stamp: 'KenD 28/Jun/2026 13:27:38'! -shallowCopy - ^self +!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +sizeOfEncoding: code + code < 0x80 ifTrue: [^1]. + code < 0xC0 ifTrue: [^0]. + code < 0xE0 ifTrue: [^2]. + code < 0xF0 ifTrue: [^3]. + code < 0xF8 ifTrue: [^4]. + ^0 ! ! -!Species methodsFor: 'errors' stamp: 'KenD 28/Jun/2026 13:27:38'! -errorNotIndexable - ^self error: 'Instances of ' , self name , ' are not indexable' +!UTF8 methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +parameterFrom: aString + | strm | + strm := (ByteArray new: aString size + 1) writeStream. + aString isCharacter + ifTrue: [self encode: aString on: strm] + ifFalse: [aString do: [:char | self encode: char on: strm]]. + strm nextPut: 0. + ^strm contents ! ! -!Species methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! -initializeOrganization - self - organization: (ClassOrganizer new classifyAll: self selectors under: nil) +!UTF8 methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +trailing: byte + (byte bitAnd: 2r11100000) = 2r11000000 ifTrue: [^1]. + (byte bitAnd: 2r11110000) = 2r11100000 ifTrue: [^2]. + (byte bitAnd: 2r11111000) = 2r11110000 ifTrue: [^3]. + ^nil ! ! -!Species methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -instanceBehavior: aBehavior - instanceBehavior := aBehavior +!UTF8 class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +accepts: aByteArray + ^self current accepts: aByteArray ! ! -!Species methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -updateInstSize - | size | - size := superclass isNil ifTrue: [0] ifFalse: [superclass instSize]. - format := format - self instSize + size + self instVarNames size +!UTF8 class methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +decodeMemory: anExternalMemory length: anInteger + ^Smalltalk os utf8ToWide: anExternalMemory length: anInteger ! ! -!Species methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! -primitiveNewBytes: size - ^self errorVMSpecific +!UTF8 class methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +encodeMemory: anExternalMemory length: anInteger + " + UTF8 encodeMemory: '→' externalCopy length: 2 + " + Smalltalk os wideToUtf8: anExternalMemory length: anInteger ! ! -!Species methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! -printOn: aStream - aStream nextPutAll: self name +!UTF8 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +prefix + ^#[16rEF 16rBB 16rBF] ! ! -!Species methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! -withAllSubclassesDo: aBlock - aBlock evaluateWith: self. - self allSubclassesDo: aBlock +!ModuleLoader methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +loadModuleNamed: aString + | classes moduleName moduleSpec moduleClass | + spec := self readModuleSpecNamed: aString. + classes := self classesSortedBySuperclass: spec classes. + moduleName := ('.' split: spec name) last asSymbol. + moduleSpec := spec classes detect: [:cls | cls name = (moduleName , #Module)] ifNone: nil. + moduleSpec ifNil: [ moduleSpec := spec classes detect: [:cls | cls name = (#Module , moduleName)] ifNone: nil]. + moduleSpec + ifNil: [ + moduleClass := Module.] + ifNotNil: [ + moduleClass := self createNewClassFrom: moduleSpec in: nil. + classes remove: moduleSpec ]. + module := self createNewModule: moduleClass. + module name isEmpty ifTrue: [ module name: moduleName asString ]. + classes do: [:c | self createNewClassFrom: c in: module ]. + spec extendedClasses do: [:c | self createExtensionMethodsOf: c ]. + module justLoaded. + Kernel loadedModules at: module name asSymbol put: module. + ^ module ! ! -!Species methodsFor: 'enumerating' stamp: 'KenD 28/Jun/2026 13:27:38'! -withAllSuperclassesDo: aBlock - aBlock evaluateWith: self. - self allSuperclassesDo: aBlock +!ModuleLoader methodsFor: 'loading' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +readModuleSpecNamed: aString + | reader | + reader := ModuleSpecReader new. + reader path: '../../modules/', aString. + ^reader read ! ! -!Species class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! -initializeFormatFlags - Flags := self addNamespace. - Flags - at: #Variable put: 16r2000; - at: #Pointers put: 16r4000 +!ModuleLoader methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +classesSortedBySuperclass: anArray + | result seen s dfs | + result := OrderedCollection new. + seen := IdentitySet new. + dfs := [ :class | + s := class superclass. + ((anArray includes: s) andNot: [ seen includes: s ]) ifTrue: [ + dfs value: s ]. + result add: class. + seen add: class ]. + anArray do: [ :class | (seen includes: class) ifFalse: [ dfs value: class ] ]. + self ASSERT: result asSet = anArray asSet. + ^ result ! ! -!Species class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! -maxInstVarCount - ^16r7F +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +createExtensionMethodsOf: aClassSpec + | class metaclass | + class := module namespace at: aClassSpec name asSymbol. + metaclass := class behavior classBinding. + aClassSpec methods do: [ :m | | cm | + cm := self createNewMethod: m in: class. + module ifNotNil: [ module addExtension: cm ] ]. + aClassSpec metaclass methods do: [ :m | | cm | + cm := self createNewMethod: m in: metaclass. + module ifNotNil: [ module addExtension: cm ] ]. + ^ module ! ! -!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! -matchFirstAfterStartOn: aMatchAlgorithm - aMatchAlgorithm matchFirstStar +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 1/Jul/2026, 7:43:23 pm (UTC)'! +createNewClassFrom: aClassSpec in: aModule + | superclass metaclass class | + superclass := (aModule ifNil: [ Kernel ]) namespace at: aClassSpec supername asSymbol. + class := Class newSubclassOf: superclass. + metaclass := class class. + class name: aClassSpec name; instVarNames: aClassSpec instVarNames; classVarNames: aClassSpec classVarNames. + aClassSpec methods do: [ :m | self createNewMethod: m in: class ]. + aClassSpec metaclass methods do: [ :m | self createNewMethod: m in: metaclass ]. + aModule ifNotNil: [ + aModule addClass: class. + class module: aModule]. + ^ class ! ! -!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! -matchFirstOn: aMatchAlgorithm - aMatchAlgorithm matchFirstStar +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026, 8:27:37 pm (UTC)'! +createNewMethod: aMethodSpec in: aSpecies + | method selector | + method := SCompiler new compile: aMethodSpec sourceCode. + selector := method selector. + method classBinding: aSpecies. + aSpecies methodDictionary at: selector put: method. + aSpecies organization classify: selector under: method category. + ^method ! ! -!StarToken methodsFor: 'double dispatching' stamp: 'KenD 28/Jun/2026 13:27:38'! -matchLastOn: aMatchAlgorithm - " - do nothing - " - +!ModuleLoader methodsFor: 'creating' stamp: 'KenD 1/Jul/2026, 7:43:47 pm (UTC)'! +createNewModule: aClass + | aModule | + aModule := aClass new. + aModule bindKernelExports; importRequiredModules. + aClass name !!= #Module ifTrue: [ aClass module: aModule. aModule addClass: aClass]. + ^aModule ! ! -!StarToken methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! -printOn: aStream - aStream nextPut: $* +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +read + self readMetadata; readClasses; readExtendedClasses. + ^module ! ! -!StarToken class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -current - ^current +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +readClass: aString + | filename reader definition pointers variable class metasclass stream contents | + filename := path / aString , '.st'. + contents := Kernel readFile: filename. + contents size = 0 ifTrue: [ + filename := path / aString , '.class.st'. + contents := Kernel readFile: filename. + contents size = 0 ifTrue: [ + self error: 'Cannot find file for class ' , aString]]. + stream := InternalReadStream on: contents. + reader := TonelReader on: stream. + [reader read] ensure: [stream close]. + definition := reader definition. + variable := pointers := true. + definition at: #type ifPresent: [:type | + variable := true. + type = #bytes ifTrue: [pointers := false]]. + class := ClassSpec new + module: module; + name: (definition at: #name) asString; + supername: (definition at: #superclass ifAbsent: nil) asString; + ivars: (definition at: #instVars ifAbsent: #()); + cvarNames: (definition at: #classVars ifAbsent: #()); + sharedPools: (definition at: #pools ifAbsent: #()); + isVariable: variable; + isPointers: pointers. + metasclass := MetaclassSpec new + module: module; + instanceClass: class; + ivars: (definition at: #classInstVars ifAbsent: #()). + class metaclass: metasclass. + module addClass: class. + reader methods do: [:m | self readMethod: m] ! ! -!StarToken class methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! -initializeCurrent - current := self new +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +readClasses + (metadata at: #classes) do: [:name | self readClass: name] ! ! -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! -+ delta - delta isInteger ifTrue: [^start + delta thru: end + delta]. - delta isPoint ifTrue: [^start + delta x thru: end + delta y]. - ^start + delta start thru: end + delta end -! ! +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +readExtendedClass: aString -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! -- delta - ^self + delta negated + | filename contents stream reader definition class metaclass | + filename := path / aString , '.st'. + contents := Kernel readFile: filename. + contents size = 0 ifTrue: [ + self error: 'Cannot find file for extended class ' , aString]. + stream := InternalReadStream on: contents. + reader := TonelReader on: stream. + [reader read] ensure: [stream close]. + definition := reader definition. + class := ClassSpec new + module: module; + name: (definition at: #name) asString. + metaclass := MetaclassSpec new module: module; instanceClass: class. + class metaclass: metaclass. + module addClassExtension: class. + reader methods do: [:m | self readMethod: m] ! ! -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! -// anInteger - ^start // anInteger thru: end // anInteger +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +readExtendedClasses + (metadata at: #extendedClasses ifAbsent: [#()]) + do: [:name | self readExtendedClass: name] ! ! -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! -center - ^start + end // 2 +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +readMetadata + | stream name classes | + stream := (Kernel readFile: path , '/package.st') readStream. + stream throughAll: 'Package '. + metadata := (STONReader on: stream) parseMap. + name := (metadata at: #name) replace: $- with: Character space. + module name: name asString. + classes := metadata at: #classes. + classes := classes copyWith: name asString, 'Module'. + metadata at: #classes put: classes ! ! -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! -down: anInteger - ^start thru: end + anInteger +!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +readMethod: aDictionary + | classname selector category class signature body source method | + classname := aDictionary at: #class. + selector := aDictionary at: #selector. + category := aDictionary at: #category. + class := module resolveClass: classname. + class isNil ifTrue: [ + self + error: 'Cannot find class for method ' , classname , ' >> #' + , selector asString]. + signature := aDictionary at: #signature. + body := aDictionary at: #body. + source := signature dosToUnix unixToMac , String cr + , body dosToUnix unixToMac. + method := MethodSpec new + module: module; + classBinding: class; + selector: selector; + category: category; + source: source. + class addMethod: method ! ! -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! -length - ^end - start + 1 +!ModuleSpecReader methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +initialize + super initialize. + module := ModuleSpec new ! ! -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 30/Jan/2023 10:10:45'! -mask - ^(2 raisedTo: end) - (2 raisedTo: start - 1) +!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +module + ^module ! ! -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! -max - ^start max: end +!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +module: aModuleSpec + module := aModuleSpec ! ! -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! -min - ^start min: end +!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! +path: aFilename + path := aFilename ! ! -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 28/Jun/2026 13:27:38'! -negated - ^start negated thru: end negated +!InlinedMessageNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +assembler: anAssembler + assembler := anAssembler +! ! + +!InlinedMessageNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +message: aMessageTreecode + message := aMessageTreecode +! ! + +!InlinedMessageNativizer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +nativizer: aTreecodeNativizer + nativizer := aTreecodeNativizer +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineAnd + | skip conditions | + skip := assembler newLabel. + conditions := Array + with: message receiver + withAll: message arguments allButLast. + conditions do: [ :c | self inlineAndCondition: c skip: skip ]. + message arguments last statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler @ skip +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineAndCondition: anSExpression skip: skip + | retry failed | + retry := assembler newLabel. + failed := assembler newLabel. + anSExpression acceptVisitor: nativizer. + assembler + @ retry; + compareRwithFalse; + jumpIfEqualTo: skip; + compareRwithTrue; + jumpIfNotEqualTo: failed. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineAndNot + | skip conditions | + skip := assembler newLabel. + conditions := Array + with: message receiver + withAll: message arguments allButLast. + conditions do: [ :c | self inlineAndCondition: c skip: skip ]. + message arguments last statements + do: [ :s | s acceptVisitor: nativizer ]. + self negateBoolean. +assembler @ skip +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineBinaryWhile: aBoolean + | retry failed block continue | + start := assembler newLabel. + retry := assembler newLabel. + failed := assembler newLabel. + block := assembler newLabel. + continue := assembler newLabel. + assembler + alignTo: 16; + @ start. + message receiver statements do: [ :s | s acceptVisitor: nativizer ]. + assembler + @ retry; + compareRwithBoolean: aBoolean; + jumpIfEqualTo: block; + compareRwithBoolean: aBoolean not; + jumpIfNotEqualTo: failed; + jumpTo: continue; + @ block. + message arguments first statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler + jumpTo: start; + @ continue. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineBranchIf: aBoolean + | retry failed first second | + retry := assembler newLabel. + failed := assembler newLabel. + end := assembler newLabel. + message receiver acceptVisitor: nativizer. + first := aBoolean not. + second := aBoolean. + assembler + @ retry; + loadAwithR; + loadRwithNil; + compareAwithBoolean: first; + jumpIfEqualTo: end; + compareAwithBoolean: second; + jumpIfNotEqualTo: failed. + message arguments first statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler @ end. + nativizer + addFallback: [ assembler @ failed; loadRwithA. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineBranchIfNil: aBoolean + + end := assembler newLabel. + message receiver acceptVisitor: nativizer. + assembler + compareRwithNil. + aBoolean + ifTrue: [ assembler jumpIfNotEqualTo: end ] + ifFalse: [ assembler jumpIfEqualTo: end ]. + message arguments first acceptVisitor: nativizer. + assembler @ end +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineBranchIfNilIfNotNil: aBoolean + | second | + second := assembler newLabel. + end := assembler newLabel. + message receiver acceptVisitor: nativizer. + assembler compareRwithNil. + aBoolean + ifTrue: [ assembler jumpIfNotEqualTo: second ] + ifFalse: [ assembler jumpIfEqualTo: second ]. + message arguments first acceptVisitor: nativizer. + assembler + jumpTo: end; + @ second. + message arguments first acceptVisitor: nativizer. + assembler @ end +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineIfTrueIfFalse: aBoolean + | retry other failed first second | + retry := assembler newLabel. + other := assembler newLabel. + failed := assembler newLabel. + end := assembler newLabel. + message receiver acceptVisitor: nativizer. + first := aBoolean not. + second := aBoolean. + assembler + @ retry; + compareRwithBoolean: first; + jumpIfEqualTo: other; + compareRwithBoolean: second; + jumpIfNotEqualTo: failed. + message arguments first statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler + jumpTo: end; + @ other. + message arguments second statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler @ end. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineMessage + | selector | + selector := message selector. + selector = #ifTrue: + ifTrue: [ ^ self inlineBranchIf: true ]. + selector = #ifFalse: + ifTrue: [ ^ self inlineBranchIf: false ]. + selector = #ifNil: + ifTrue: [ ^ self inlineBranchIfNil: true ]. + selector = #ifNotNil: + ifTrue: [ ^ self inlineBranchIfNil: false ]. + selector = #ifNil:ifNotNil: + ifTrue: [ ^ self inlineBranchIfNilIfNotNil: true ]. + selector = #ifNil:ifNotNil: + ifTrue: [ ^ self inlineBranchIfNilIfNotNil: false ]. + selector = #ifTrue:ifFalse: + ifTrue: [ ^ self inlineIfTrueIfFalse: true ]. + selector = #ifFalse:ifTrue: + ifTrue: [ ^ self inlineIfTrueIfFalse: false ]. + selector = #whileTrue + ifTrue: [ ^ self inlineUnitaryWhile: true ]. + selector = #whileFalse + ifTrue: [ ^ self inlineUnitaryWhile: false ]. + selector = #whileTrue: + ifTrue: [ ^ self inlineBinaryWhile: true ]. + selector = #whileFalse: + ifTrue: [ ^ self inlineBinaryWhile: false ]. + selector = #repeat + ifTrue: [ ^ self inlineRepeat ]. + selector = #to:do: + ifTrue: [ ^ self inlineToDo ]. + selector = #to:by:do: + ifTrue: [ ^ self inlineToByDo]. + selector = #timesRepeat: + ifTrue: [ ^ self inlineTimesRepeat ]. + (selector beginsWith: #or:) + ifTrue: [ ^ self inlineOr ]. + (selector beginsWith: #and:) + ifTrue: [ ^ self inlineAnd ]. + selector = #andNot: + ifTrue: [ ^ self inlineAndNot ]. + selector = #orNot: + ifTrue: [ ^ self inlineOrNot ]. + self ASSERT: false ! ! -!Stretch methodsFor: 'arithmetic' stamp: 'KenD 30/Jan/2023 10:10:45'! -shift - ^(start - 1) negated -! ! +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineOr + | skip conditions | + skip := assembler newLabel. + conditions := Array + with: message receiver + withAll: message arguments allButLast. + conditions do: [ :c | self inlineOrCondition: c skip: skip ]. + message arguments last statements + do: [ :s | s acceptVisitor: nativizer ]. + assembler @ skip +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineOrBlock: b skip: skip + | retry failed | + retry := assembler newLabel. + failed := assembler newLabel. + b statements acceptVisitor: nativizer. + assembler + @ retry; + compareRwithTrue; + jumpIfEqualTo: skip; + compareRwithFalse; + jumpIfNotEqualTo: failed. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineOrCondition: anSExpression skip: skip + | retry failed | + retry := assembler newLabel. + failed := assembler newLabel. + + anSExpression acceptVisitor: nativizer. + assembler + @ retry; + compareRwithTrue; + jumpIfEqualTo: skip; + compareRwithFalse; + jumpIfNotEqualTo: failed. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineOrNot + | skip conditions | + skip := assembler newLabel. + conditions := Array + with: message receiver + withAll: message arguments allButLast. + conditions do: [ :c | self inlineOrCondition: c skip: skip ]. + message arguments last statements + do: [ :s | s acceptVisitor: nativizer ]. + self negateBoolean. + assembler @ skip +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineRepeat + start := assembler newLabel. + assembler + alignTo: 16; + @ start. + message receiver statements do: [ :s | s acceptVisitor: nativizer ]. + assembler jumpTo: start +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineTimesRepeat + | head block continue nonInteger nonDecrementable current | + head := assembler newLabel. + block := assembler newLabel. + continue := assembler newLabel. + nonInteger := assembler newLabel. + nonDecrementable := assembler newLabel. + message receiver acceptVisitor: nativizer. + current := nativizer pushR. + assembler + alignTo: 16; + @ head; + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonInteger; + compareRwithSmallInteger: 0; + jumpIfLessOrEqualSignedTo: continue; + @ block. + message arguments first statements + do: [ :s | s acceptVisitor: nativizer ]. + nativizer loadRwithStack: current. + assembler + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonDecrementable; + subFromRconstant: 2. + nativizer storeRInStack: current. + assembler + jumpTo: head; + @ continue. + nativizer + dropTos; + addFallback: [ assembler + @ nonDecrementable; + pushSmallInteger: 1. + nativizer + emitSend: #-; + storeRInStack: current. + assembler jumpTo: head ]; + addFallback: [ assembler + @ nonInteger; + pushSmallInteger: 0. + nativizer emitSend: #>. + assembler + compareRwithTrue; + jumpIfEqualTo: block; + jumpTo: continue ] + +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineToByDo + | head block continue nonInteger nonIncrementable overflow current limit by increment | + head := assembler newLabel. + block := assembler newLabel. + continue := assembler newLabel. + nonInteger := assembler newLabel. + nonIncrementable := assembler newLabel. + overflow := assembler newLabel. + message receiver acceptVisitor: nativizer. + current := message arguments third inlinedArgs first. + nativizer temporaryInStackAtPut: current. + message arguments first acceptVisitor: nativizer. + limit := nativizer pushR. + assembler loadAwithR. + nativizer temporaryInStackAt: current. + assembler + alignTo: 16; + @ head; + testIntegerBitOf: assembler regA; + jumpIfZeroTo: nonInteger; + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonInteger; + compareRwithA. + by := message arguments second value. + by > 0 + ifTrue: [ assembler jumpIfGreaterSignedTo: continue ] + ifFalse: [ assembler jumpIfLessSignedTo: continue ]. + increment := (assembler smallInteger: by) - 1. + assembler @ block. + message arguments third statements + do: [ :s | s acceptVisitor: nativizer ]. + nativizer temporaryInStackAt: current. + assembler + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonIncrementable; + addRwithImmediate: increment; + jumpIfOverflowTo: overflow. + nativizer + temporaryInStackAtPut: current; + loadAwithStack: limit. + assembler + jumpTo: head; + @ continue. + nativizer dropTos; + addFallback: [ assembler + @ overflow; + subFromRconstant: increment; + @ nonIncrementable; + pushSmallInteger: 1. + nativizer + emitSend: #+; + temporaryInStackAtPut: current; + loadAwithStack: limit. + assembler jumpTo: head ]; + addFallback: [ assembler + @ nonInteger; + pushA. + nativizer emitSend: #<=. + assembler + compareRwithTrue; + jumpIfEqualTo: block; + jumpTo: continue ] + +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineToDo + | head block continue nonInteger nonIncrementable overflow current limit | + head := assembler newLabel. + block := assembler newLabel. + continue := assembler newLabel. + nonInteger := assembler newLabel. + nonIncrementable := assembler newLabel. + overflow := assembler newLabel. + message receiver acceptVisitor: nativizer. + current := message arguments second inlinedArgs first. + nativizer temporaryInStackAtPut: current. + message arguments first acceptVisitor: nativizer. + limit := nativizer pushR. + assembler loadAwithR. + nativizer temporaryInStackAt: current. + assembler + alignTo: 16; + @ head; + testIntegerBitOf: assembler regA; + jumpIfZeroTo: nonInteger; + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonInteger; + compareRwithA; + jumpIfGreaterSignedTo: continue; + @ block. + message arguments second statements + do: [ :s | s acceptVisitor: nativizer ]. + nativizer temporaryInStackAt: current. + assembler + testIntegerBitOf: assembler regR; + jumpIfZeroTo: nonIncrementable; + addRwithImmediate: 2; + jumpIfOverflowTo: overflow. + nativizer + temporaryInStackAtPut: current; + loadAwithStack: limit. + assembler + jumpTo: head; + @ continue. + nativizer dropTos; + addFallback: [ assembler + @ overflow; + subFromRconstant: 2; + @ nonIncrementable; + pushSmallInteger: 1. + nativizer + emitSend: #+; + temporaryInStackAtPut: current; + loadAwithStack: limit. + assembler jumpTo: head ]; + addFallback: [ assembler + @ nonInteger; + pushA. + nativizer emitSend: #<=. + assembler + compareRwithTrue; + jumpIfEqualTo: block; + jumpTo: continue ] + +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +inlineUnitaryWhile: aBoolean + | continue failed | + start := assembler newLabel. + continue := assembler newLabel. + failed := assembler newLabel. + assembler + alignTo: 16; + @ start. + message receiver statements do: [ :s | s acceptVisitor: nativizer ]. + assembler + compareRwithBoolean: aBoolean; + jumpIfEqualTo: start; + compareRwithBoolean: aBoolean not; + jumpIfNotEqualTo: failed; + @ continue. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: continue ] +! ! + +!InlinedMessageNativizer methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +negateBoolean + | retry failed done | + retry := assembler newLabel. + failed := assembler newLabel. + done := assembler newLabel. + assembler + @ retry; + loadAwithR; + loadRwithFalse; + compareRwithA; + jumpIfEqualTo: done; + loadRwithTrue; + compareRwithA; + jumpIfNotEqualTo: failed; @done. + nativizer + addFallback: [ assembler @ failed. + nativizer sendMustBeBoolean. + assembler jumpTo: retry ] +! ! + +!MessageLinker methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +canInline: aSymbol + filter ifNil: [ ^true ]. + filter == aSymbol ifTrue: [ ^true ]. + ^(filter includes: aSymbol) +! ! + +!MessageLinker methodsFor: 'testing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +filter: anObject + filter := anObject. + filter isCollection ifTrue: [filter := filter asIdentitySet] +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleAsFloatInto + #_asFloatInto:. + assembler + loadX0withRasDouble; + storeLargeX0inA. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleAsNative + | noninteger | + #_asNative. + noninteger := assembler labeledIntegerBitTestOfR. + assembler + convertRtoNativeInteger; + @ noninteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleAsObject + #_asObject. + assembler clearSafeRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleAsPointer + | nonInteger | + #_asPointer. + nonInteger := assembler labeledIntegerBitTestOfR. + assembler + convertRtoNativeInteger; + @ nonInteger; + setSafeRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleAsSmallInteger + #_asSmallInteger. + assembler convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicAt + | oop | + #_basicAt:. + oop := assembler labeledIntegerNativizationOfA. + assembler + loadRwithRatA; + @ oop +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicAtPut + | nonInteger | + #_basicAt:put:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + storeTinRatA; + @ nonInteger; + loadRwithT +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicCopyFromToWith + #_basicCopyFrom:to:with:. + assembler + pushE; + convertAtoNativeInteger; + convertTtoNativeInteger; + loadEwithAddressOfRatA; + loadSwithAddressOfSatA; + subAfromT; + addTwithImmediate: 1; + moveTslots; + popE +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicFlags + #_basicFlags. + self emitByteAtOffset: _Flags +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicFlagsPut + #_basicFlags:. + self emitByteAtOffsetPut: _Flags +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicHash + #_basicHash. + assembler + loadZeroExtendShortRwithRoffset: _Hash; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicHashPut + | nonInteger | + #_basicHash:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + storeShortAinRoffset: _Hash; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicSize + #_smallSize. + self emitByteAtOffset: _SmallSize +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicSizePut + #_smallSize:. + self emitByteAtOffsetPut: _SmallSize +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicULongAt + | nonInteger | + #_basicULongAt:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + loadZeroExtendLongRwithRatA; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBasicULongAtPut + | nonInteger | + #_basicULongAt:put:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + storeLongTinRatA; + @ nonInteger; + loadRwithT +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBeCurrent + #_beCurrent. + assembler + loadRwithRindex: 1; + clearSafeRintegerBit; + loadFPwithR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBeEnvironment + #_beEnvironment. + assembler loadEwithR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBeFramePointer + #_beFramePointer. + assembler storeRinFPindex: 1 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBitShiftLeft + | success | + #_bitShiftLeft:. + success := assembler newLabel. + assembler + loadTwithA; + loadAwithR; + clearSafeRintegerBit; + convertTtoNativeInteger; + shiftLeftRwithT; + setSafeRintegerBit; + pushR; + shiftRightRwithT; + setSafeRintegerBit; + compareRwithA; + popR; + shortJumpIfEqualTo: success; + loadRwithNil; + @ success +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBitShiftRight + #_bitShiftRight:. + assembler + move: assembler regA to: assembler regT; + convertToNativeInteger: assembler regT; + shiftRightArithmetic: assembler regR by: assembler regT b; + setIntegerBit: assembler regR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleBusyWait + | loop | + #_busyWait. + loop := assembler newLabel. + assembler + loadTwithImmediate: 0; + @ loop; + exchangeRindirectWithT; + compareTwithImmediate: 0; + shortJumpIfEqualTo: loop +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleByteAt + | nonInteger | + #_byteAt:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + loadZeroExtendByteRwithRatA; + convertRtoSmallInteger; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleByteAtPut + | nonInteger1 nonInteger2 | + #_byteAt:put:. + nonInteger1 := assembler labeledIntegerNativizationOfA. + nonInteger2 := assembler labeledIntegerNativizationOfT. + assembler + storeByteTinRatA; + @ nonInteger1; + @ nonInteger2; + loadRwithT; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleCDeclCallWithArguments + #_cdeclCallWithArguments:. + assembler + loadZeroExtendByteTwithAindex: _SmallSize + 1; + shiftTright: assembler wordSizeShift; + pushS; + saveCallerFrame; + subTslotsToSP; + assemble: 'and' with: assembler regSP with: -16; + loopTtimes: [ assembler + load: assembler regS + fromMem: assembler memRefAatT; + store: assembler regS + intoMem: assembler memRefSPatT ]. + assembler addressSize = 8 + ifTrue: [ self loadArgumentsIntoRegisters ]. + assembler + callR; + restoreCallerFrame; + popS +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleCallWithArguments + #_stdcallWithArguments:. + assembler + loadZeroExtendByteTwithAindex: _SmallSize + 1; + shiftTright: assembler wordSizeShift; + loopTtimes: [ assembler pushAatToffset: 0 - assembler addressSize ]. + assembler addressSize = 8 + ifTrue: [ self loadArgumentsIntoRegisters ]. + assembler callR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleEnvironment + #_environment. + assembler loadRwithE +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleExpandInStackSized + #_expandInStackSized:. + assembler + convertAtoNativeInteger; + loadTwithA; + loopTtimes: [ assembler + pushIndirectR; + addRwithImmediate: assembler wordSize ] +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleExtendedSize + #_largeSize. + assembler + loadZeroExtendLongRwithRindex: _ExtendedSize; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleFloatEquals + " + first compare magnitudes to set error bit if NaN + " + #_floatEquals:. + assembler + pushR; + loadLargeX0withRindirect; + compareLessThanDoubleX0withAindirect; + popR; + loadLargeX0withRindirect; + compareEqualDoubleX0withAindirect; + moveX0toR; + addRwithImmediate: 1; + convertRtoSmallInteger. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleFloatFractionPartInto + #_floatFractionPartInto:. + assembler + loadLargeX0withRindirect; + roundDoubleX0intoX1; + subDoubleX1fromX0; + storeLargeX0inA. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleFloatLessThan + #_floatLessThan:. + assembler + loadLargeX0withRindirect; + compareLessThanDoubleX0withAindirect; + moveX0toR; + addRwithImmediate: 1; + convertRtoSmallInteger. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleFloatMinusInto + #_floatMinus:into:. + assembler + loadLargeX0withRindirect; + loadLargeX1withAindirect; + subDoubleX1fromX0; + storeLargeX0inT. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleFloatMultiplyInto + #_floatMultiply:into:. + assembler + loadLargeX0withRindirect; + loadLargeX1withAindirect; + multiplyDoubleX0byX1; + storeLargeX0inT. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleFloatPlusInto + #_floatPlus:into:. + assembler + loadLargeX0withRindirect; + loadLargeX1withAindirect; + addDoubleX1toX0; + storeLargeX0inT. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleFloatQuotientInto + #_floatQuotient:into:. + assembler + loadLargeX0withRindirect; + loadLargeX1withAindirect; + divideDoubleX0byX1; + storeLargeX0inT. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleFloatSqrtInto + #_floatSqrtInto:. + assembler + loadLargeX0withRindirect; + sqrtDoubleX0; + storeLargeX0inA. + self readFloatStatus +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleFloatTruncated + #_floatTruncated. + assembler loadRconvertingDoublePointedByR. + self readFloatStatus. + assembler convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleFramePointer + #_framePointer. + assembler loadRwithFPindex: 1 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleGetTIBValue + | nonInteger | + #_getThreadInformationBlockValue. + nonInteger := assembler labeledIntegerNativizationOfR. + assembler + loadRwithTIBatR; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleGetThreadValue + | nonInteger uninitialized | + #_getThreadValue. + nonInteger := assembler labeledIntegerNativizationOfR. + uninitialized := assembler newLabel. + assembler + loadRwithThreadVariableAtR; + compareRwithImmediate: 0; + shortJumpIfEqualTo: uninitialized. + assembler + jumpOver: [ assembler + @ uninitialized; + @ nonInteger; + loadRwithNil ] +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleHigh16 + #_high16. + assembler wordSize > 4 + ifTrue: [ assembler clearRhigh32 ]. + assembler + shiftRright: 15; + setSafeRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleHigh32 + #_high32. + assembler + shiftLogicalRright: 31; + setSafeRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleHoldRefererIfNeeded + #_holdRefererIfNeeded:. + assembler + pushA; + loadAwithGlobal: #WriteBarrier; + callIndirectA; + popA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleIntegerMultiplyByInto + #_integerMultiplyBy:into:. + assembler + convertRtoNativeInteger; + convertAtoNativeInteger; + multiplyRbyAwideningToA; + storeRinTindex: 1; + storeAinTindex: 2; + loadRwithT +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleInvoke + #_invoke:. + assembler + loadMwithA; + callIndirectM +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleLeadingZeroBitCount + #_leadingZeroBitCount. + assembler + convertRtoNativeInteger; + leadingRzeroCount; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleLoadFloatStatusFrom + #_status:. + assembler loadMXCSRfromA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleLow16 + #_low16. + assembler + andRwithImmediate: 16rFFFF; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleLow32 + #_low32. + assembler wordSize > 4 + ifTrue: [ assembler + andRwithImmediate: 16rFFFFFFFF; + convertRtoSmallInteger ] +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleNativeHalt + #_halt. + assembler breakpoint +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleNilSlots + #_nilSlots:. + assembler + pushE; + loadEwithR; + loadRwithNil; + loadTwithA; + convertTtoNativeInteger; + writeTslots; + popE +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleObjectAtOffset + | nonInteger1 | + #_objectAtOffset:. + nonInteger1 := assembler labeledIntegerNativizationOfA. + assembler + loadRwithRatOffsetA; + @ nonInteger1 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleObjectAtOffsetPut + | oop | + #_objectAtOffset:put:. + oop := assembler labeledIntegerNativizationOfA. + assembler + storeTinRatOffsetA; + @ oop; + loadRwithT; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleOop + #_oop. + ^ assembler convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleQuotientTowardZero + #_quotientTowardZero:. + assembler + convertRtoNativeInteger; + convertAtoNativeInteger; + loadTwithA; + extendRtoAandDividebyT; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleRelease + #_release. + assembler + lock; + decRindirect +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleRemainderTowardZero + | adapt convert | + #_remainderTowardZero:. + adapt := assembler newLabel. + convert := assembler newLabel. + assembler + convertRtoNativeInteger; + convertAtoNativeInteger; + loadTwithA; + xorAwithR; + jumpIfSignTo: adapt; + extendRtoAandDividebyT; + loadRwithA; + jumpTo: convert; + @ adapt; + extendRtoAandDividebyT; + loadRwithA; + testRwithR; + jumpIfZeroTo: convert; + addTtoR; + @ convert; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleRestore + #_restore. + assembler loadEwithR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleRestoreAndTransferControlWithContext + #_restoreAndTransferControlWithContext:. + assembler + clearSafeRintegerBit; + loadFPwithR; + loadSPwithFP; + loadRwithA; + clearSafeRintegerBit; + loadFPwithR; + popR; + loadEwithR; + restoreCallerSelf; + restoreCallerM; + loadRwithS; + return: 0 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleRestoreWithContext + #_restoreWithContext:. + assembler + clearSafeRintegerBit; + loadFPwithR; + loadSPwithFP; + loadRwithA; + clearSafeRintegerBit; + loadFPwithR +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleSaveCurrentEnvironment + #_saveCurrentEnvironment. + assembler + clearSafeRintegerBit; + pushE; + popT; + storeTinRindex: 1; + setSafeRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleSetTIBValue + #_setThreadInformationBlockValue:. + assembler + convertRtoNativeInteger; + storeTIBatRwithA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleSetThreadValue + | nonInteger | + #_setThreadValue:. + nonInteger := assembler labeledIntegerNativizationOfR. + assembler + storeAinThreadVariableAtIndexR; + convertRtoSmallInteger. + assembler @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleSmallIntegerByteAt + | nonInteger | + #_smallIntegerByteAt:. + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + convertRtoNativeInteger; + pushR; + loadZeroExtendByteRwithSPatA; + convertRtoSmallInteger; + popA; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleStoreDoubleResult + #_storeDoubleResult. + assembler storeDoubleResultInRindirect +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleStoreFloatStatusInto + #_readStatusOn:. + assembler storeMXCSRintoA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleTestSmallInteger + | integer | + #_isSmallInteger. + integer := assembler newLabel. + assembler + testRintegerBit; + loadRwithTrue; + shortJumpIfNotZeroTo: integer; + loadRwithFalse; + @ integer +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleThisContext + #_thisContext. + assembler loadRwithFP setRintegerBit +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleTimesTwoPower + #_timesTwoPower:. + assembler clearFPUFlags scaleFloatOnRWithA clearFPUFlags +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleTransferControlDiscardingLastArgTo + #_transferControlDiscardingLastArgTo:. + assembler + restoreCallerFrame; + popSPindirect; + loadMwithA; + jumpToMindex: 1 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleTransferControlTo + #_transferControlTo:. + assembler restoreCallerFrame; loadMwithA; jumpToMindex: 1 +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleULargeAtOffset + | overflow1 overflow2 end | + #_uLargeAtOffset:. + overflow1 := assembler newLabel. + overflow2 := assembler newLabel. + end := assembler newLabel. + assembler + convertAtoNativeInteger; + loadRwithRatOffsetA; + shiftRleft: 1; + shortJumpIfCarryTo: overflow1; + shortJumpIfSignTo: overflow2; + setRintegerBit; + shortJumpTo: end. + assembler + @ overflow1; + @ overflow2; + loadRwithNil; + @ end +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleULargeAtOffsetInto + #_uLargeAtOffset:into:. + assembler + convertAtoNativeInteger; + loadAwithRoffsetAtA; + storeAinTindex: 1; + loadRwithT +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleULargeAtOffsetPut + | end notSmall | + #_uLargeAtOffset:put:. + notSmall := assembler + convertAtoNativeInteger; + labeledIntegerBitTestOfT. + end := assembler newLabel. + assembler + convertTtoNativeInteger; + shortJumpTo: end; + @ notSmall; + loadTwithTindex: 1; + @ end; + storeTinRatOffsetA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleULongAtOffset + | overflow1 overflow2 end | + #_uLongAtOffset:. + overflow1 := assembler newLabel. + overflow2 := assembler newLabel. + end := assembler newLabel. + assembler + convertAtoNativeInteger; + loadLongRwithRatOffsetA; + shiftRleft: 1; + shortJumpIfCarryTo: overflow1; + shortJumpIfSignTo: overflow2; + setRintegerBit; + shortJumpTo: end. + assembler + @ overflow1; + @ overflow2; + loadRwithNil; + @ end +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleULongAtOffsetInto + #_uLongAtOffset:into:. + assembler + convertAtoNativeInteger; + loadLongRwithRatOffsetA; + storeRinTindex: 1; + loadRwithT +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleULongAtOffsetPut + | end oop | + #_uLongAtOffset:put:. + oop := assembler + convertAtoNativeInteger; + labeledIntegerBitTestOfT. + end := assembler newLabel. + assembler + convertTtoNativeInteger; + shortJumpTo: end; + @ oop; + loadTwithTindex: 1; + @ end; + storeLongTinRatOffsetA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleUShortAtOffsetPut + | end notSmall | + #_uShortAtOffset:put:. + notSmall := assembler + convertAtoNativeInteger; + labeledIntegerBitTestOfT. + end := assembler newLabel. + assembler + convertTtoNativeInteger; + shortJumpTo: end. + assembler + @ notSmall; + loadTwithTindex: 1; + @ end; + storeShortTinRatOffsetA +! ! + +!InlineMessageLinker methodsFor: 'private - assemble' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assembleZeroSlots + #_zeroSlots:. + assembler + pushE; + loadEwithR; + loadRwithImmediate: 0; + loadTwithA; + convertTtoNativeInteger; + writeTslots; + popE +! ! + +!InlineMessageLinker methodsFor: 'private - helpers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +emitByteAtOffset: offset + assembler + loadZeroExtendByteRwithRindex: offset + 1; + convertRtoSmallInteger +! ! + +!InlineMessageLinker methodsFor: 'private - helpers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +emitByteAtOffsetPut: offset + | nonInteger | + nonInteger := assembler labeledIntegerNativizationOfA. + assembler + storeByteAinRindex: offset + 1; + @ nonInteger +! ! + +!InlineMessageLinker methodsFor: 'private - helpers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +loadArgumentsIntoRegisters + | stack1 stack2 stack3 stack4 | + stack1 :=assembler memRef: rsp indexImm: 1. + stack2 :=assembler memRef: rsp indexImm: 2. + stack3 :=assembler memRef: rsp indexImm: 3. + stack4 :=assembler memRef: rsp indexImm: 4. + assembler + load: rcx fromMem: stack1; + load: rdx fromMem: stack2; + load: r8 fromMem: stack3; + load: r9 fromMem: stack4; + assemble: 'movq' with: xmm0 with: rcx; + assemble: 'movq' with: xmm1 with: rdx; + assemble: 'movq' with: xmm2 with: r8; + assemble: 'movq' with: xmm3 with: r9 +! ! + +!InlineMessageLinker methodsFor: 'private - helpers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +readFPUStatus + assembler + loadAwithKnown: #FloatStatus; + readFPUStatusOnA +! ! + +!InlineMessageLinker methodsFor: 'private - helpers' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +readFloatStatus + assembler + loadAwithKnown: #FloatStatus; + storeMXCSRintoA +! ! + +!InlineMessageLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +emitSend: aSymbol using: anAssembler + | arity selector | + assembler := anAssembler. + arity := aSymbol arity. + arity > 2 ifTrue: [assembler pop: assembler regS]. + arity > 1 ifTrue: [assembler pop: assembler regT]. + arity > 0 ifTrue: [assembler pop: assembler regA]. + self ASSERT: arity <= 3 . + selector := map at: aSymbol. + self perform: selector +! ! + +!InlineMessageLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +emitSendDebuggable: aSymbol using: anAssembler + self emitSend: aSymbol using: anAssembler +! ! + +!InlineMessageLinker methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + map := Dictionary new. + self class supported do:[:each|map add: each]. + self filter: map keys asIdentitySet -!Stretch methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! -= aStretch - self class == aStretch class ifFalse: [^false]. - ^start = aStretch start and: [end = aStretch end] -! ! + " + InlineMessageLinker new + " -!Stretch methodsFor: 'comparing' stamp: 'KenD 28/Jun/2026 13:27:38'! -hash - ^start hashWith: end ! ! -!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -end - ^end -! ! +!InlineMessageLinker class methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeInlineMessageLinkerFlags + self addNamespaceAs: #InlineMessageLinkerFlags. + InlineMessageLinkerFlags + at: #_Flags put: -5; + at: #_SmallSize put: -6; + at: #_Hash put: -8; + at: #_Reserved put: -2; + at: #_ExtendedSize put: -3. -!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -end: anInteger - end := anInteger ! ! -!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -start - ^start -! ! +!InlineMessageLinker class methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +supported + | selectors | + selectors := self organization selectorsFor: #'private - assemble'. + ^selectors collect: [:selector | | cm key | + cm := self >> selector. + key := cm literals detect: [:each | each isSymbol and:[each first == $_ ]]. + key -> selector]. -!Stretch methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -start: anInteger - start := anInteger -! ! + " + InlineMessageLinker supported + " -!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -includes: anInteger - ^anInteger between: start and: end ! ! -!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -intersects: aStretch - self isEmpty ifTrue: [^false]. - (aStretch includes: start) ifTrue: [^true]. - ^aStretch includes: end +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addMethod: aCompiledMethod + self addMethod: aCompiledMethod for: aCompiledMethod selector ! ! -!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -isEmpty - ^end < start +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addMethod: aCompiledMethod for: aSymbol + | instructions send | + filter add: aSymbol. + instructions := invoker ifNil: [ aCompiledMethod nativeCode code ]. + send := SendSite invoking: aCompiledMethod using: instructions. + sends at: aSymbol put: send ! ! -!Stretch methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -notEmpty - ^start <= end +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +addMethods: aCollection + aCollection do: [:m | self addMethod: m] ! ! -!Stretch methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! -printOn: aStream - aStream - nextPutAll: start asString; - nextPutAll: ' thru: '; - nextPutAll: end asString +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +emitSend: aSymbol using: anAssembler + | send | + send := sends at: aSymbol. + anAssembler + loadAwithLiteral: send; + callIndirectA; + discardArguments: aSymbol arity ! ! -!Stretch class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -from: start thru: end - ^self new start: start; end: end +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + super initialize. + sends := Dictionary new. + self filter: #() ! ! -!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:38'! -addStar - stream atEnd ifTrue: [^self]. - tokens add: StarToken current. - stream next. - [stream peek ifNil: [^self] ifNotNil: [:c | c isAsterisk]] - whileTrue: [stream next] +!InvokeLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +invoker: aNativeCode + invoker := aNativeCode ! ! -!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:38'! -addToken - | star pos end token | - star := false. - pos := stream position + 1. - [stream atEnd or: [star := stream next isAsterisk]] whileFalse. - star ifTrue: [stream skip: -1]. - end := stream position. - pos <= end ifTrue: [ - token := MatchToken on: stream collection from: pos to: end. - tokens add: token] +!LookupLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +emitSend: aSymbol using: anAssembler + | send | + send := SendSite new lookup: aSymbol using: lookup. + anAssembler + loadAwithLiteral: send; + callIndirectA; + discardArguments: aSymbol arity. + ^send ! ! -!StringPattern methodsFor: 'scanning' stamp: 'KenD 28/Jun/2026 13:27:38'! -scan - [stream atEnd] whileFalse: [self addToken; addStar] +!LookupLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +emitSendSuper: aSymbol from: aClass using: anAssembler + | send behavior | + send := SendSite new lookup: aSymbol using: lookupSuper; beSuperSend. + behavior := aClass superclass map instanceBehavior. + anAssembler + loadAwithLiteral: send; + loadTwithLiteral: behavior; + callIndirectA; + discardArguments: aSymbol arity. + ^send ! ! -!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -input - ^stream contents -! ! +!LookupLinker methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initializeFrom: anLMRModule + lookup := anLMRModule lookupStub. + lookupSuper := anLMRModule lookupSuperStub. -!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -on: aString - stream := aString readStream. - tokens := OrderedCollection new. - self scan ! ! -!StringPattern methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -tokens - ^tokens copy +!LookupLinker methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +lookup: aByteArray + lookup := aByteArray ! ! -!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -match: aString - ^self match: aString index: 1 +!LookupLinker methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +lookupSuper: aByteArray + lookupSuper := aByteArray ! ! -!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -match: aString ifAbsent: aBlock - ^self match: aString index: 1 ifAbsent: aBlock +!LazyLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +emitSend: aSymbol using: anAssembler + | send | + send := super emitSend: aSymbol using: anAssembler. + sends add: send ! ! -!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -match: aString index: anInteger - ^self match: aString index: anInteger ifAbsent: nil -! ! +!LazyLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + super initialize. + sends := OrderedCollection new -!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -match: aString index: anInteger ifAbsent: aBlock - | algorithm | - algorithm := MatchAlgorithm new - pattern: self; - string: aString; - index: anInteger. - algorithm run. - algorithm hasMatched ifTrue: [^algorithm matchRange]. - ^aBlock notNil ifTrue: [ - aBlock arity = 0 - ifTrue: [aBlock value] - ifFalse: [aBlock evaluateWith: algorithm failure]] ! ! -!StringPattern methodsFor: 'inquiries' stamp: 'KenD 28/Jun/2026 13:27:38'! -matches: aString - | range | - range := self match: aString. - ^range notNil and: [range x = 1 and: [range y = aString size]] -! ! +!LazyLinker methodsFor: 'nativizing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sends + ^sends -!StringPattern methodsFor: 'printing' stamp: 'KenD 28/Jun/2026 13:27:38'! -printOn: aStream - tokens do: [:t | t printOn: aStream] ! ! -!StringPattern class methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! -on: aString - ^self new on: aString +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +abi + ^platform abi ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -characterIndexOf: aString at: anInteger - | index s | - index := 0. - s := 0. - [s < anInteger] whileTrue: [| ch len | - index := index + 1. - ch := aString at: index. - len := self sizeOfCharacter: ch. - s := s + len]. - ^index +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +addLinker: aLinker + messageLinker add: aLinker ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -decodeStringFrom: aStream - ^self - decodeStringFrom: aStream - length: aStream size // self minBytesPerChar +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlinedMethods + ^inlinedMethods ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -decodeStringFrom: aStream length: anInteger - | string | - string := String new: anInteger. - ^self decodeStringFrom: aStream on: string +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +inlinedMethods: aCollection + inlinedMethods := aCollection ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -decodeStringFrom: aStream on: buffer - | bytes code string index n | - bytes := true. - index := 0. - code := nil. - string := buffer. - n := string size. - [aStream atEnd or: [code = 0] or: [index >= n]] whileFalse: [ - code := self decodeFrom: aStream. - (bytes andNot: [Ansi isAnsi: code]) ifTrue: [ - bytes := false. - string := string asWideString]. - code = 0 ifFalse: [ - index := index + 1. - string at: index putCode: code]]. - ^index < string size ifTrue: [string copyTo: index] ifFalse: [string] +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +invokedMethods + ^invokedMethods ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -externalCopyOf: aString - | bytes | - aString isNil ifTrue: [^nil]. - bytes := self parameterFrom: aString. - ^bytes externalCopy +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +invokedMethods: aCollection + invokedMethods := aCollection asOrderedCollection ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -indexesOf: aString from: start to: end - " - UTF16 current indexesOf: (WideString with: $𝑎 with: $_ with: $𝑎 with: $→) from: 2 to: 3 - " - | s e | - s := 1. - 1 to: start - 1 do: [:i | | ch len | - ch := aString at: i. - len := self sizeOfCharacter: ch. - s := s + len]. - e := s - 1. - start to: end do: [:i | | ch len | - ch := aString at: i. - len := self sizeOfCharacter: ch. - e := e + len]. - ^s thru: e +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +messageLinker + ^messageLinker ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -isString: s1 greaterThan: s2 - ^(self compareStringiW: s1 with: s2) > 0 +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +messageLinker: aLinker + messageLinker := aLinker ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -isString: s1 greaterThanOrEqualTo: s2 - ^(self compareStringiW: s1 with: s2) >= 0 +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodNativizer + ^cachedNativizer ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -isString: s1 lessThan: s2 - ^(self compareStringiW: s1 with: s2) < 0 +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +optimizedMethods + ^optimizedMethods ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -isString: s1 lessThanOrEqualTo: s2 - ^(self compareStringiW: s1 with: s2) <= 0 +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +optimizedMethods: aCollection + optimizedMethods := aCollection ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -lowercaseOf: aString - ^UTF16 current lowercaseOf: aString +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +platform + ^platform ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -sizeInBytesOf: aString - | size | - size := self sizeOfCharacter: Character null. - 1 to: aString size do: [:i | | ch s | - ch := aString at: i. - s := self sizeOfCharacter: ch. - size := size + s]. - ^size +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +platform: aNativizationPlatform + platform := aNativizationPlatform ! ! -!Unicode methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -uppercaseOf: aString - ^UTF16 current uppercaseOf: aString +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +safepointCheck: anObject + safepointCheck := anObject ! ! -!Unicode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -compareStringiW: aString1 with: aString2 - ^UTF16 current compareStringiW: aString1 with: aString2 +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +wordSize + ^self abi wordSize ! ! -!Unicode methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -minBytesPerChar - ^1 +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +wordSizeShift + ^self abi wordSizeShift ! ! -!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -decode: aByteArray - ^self decodeStringFrom: aByteArray readStream +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +writeBarrier + ^writeBarrier ! ! -!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -decodeFrom: aStream - self subclassResponsibility +!NativizationEnvironment methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +writeBarrier: aCompiledMethod + writeBarrier := aCompiledMethod. + invokedMethods add: writeBarrier ! ! -!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -encode: aString - ^ByteArray - streamContents: [:strm | aString do: [:ch | self encode: ch on: strm]] +!NativizationEnvironment methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +completeInitialization + cachedNativizer := self newTemplateJIT ! ! -!Unicode methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -encode: aCharacter on: aStream - self subclassResponsibility +!NativizationEnvironment methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initialize + busy := false. + optimizedMethods := OrderedCollection new. + invokedMethods := OrderedCollection new. + inlinedMethods := OrderedCollection new. + messageLinker := CompositeMessageLinker new. + messageLinker add: InlineMessageLinker new. +! ! + +!NativizationEnvironment methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +initializeLinkersFor: anLMRModule + | invoker dispatcher | + invoker := InvokeLinker new invoker: anLMRModule invokeStub; addMethods: invokedMethods. + dispatcher := LookupLinker new initializeFrom: anLMRModule. + self + addLinker: invoker; + addLinker: dispatcher; + completeInitialization ! ! -!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -decode: aByteArray - ^self current decode: aByteArray +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativize: aCompiledMethod + ^(self shouldOptimize: aCompiledMethod) + ifTrue: [ self nativizeOptimizing: aCompiledMethod ] + ifFalse: [ self nativizeWithoutOptimizing: aCompiledMethod ] ! ! -!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -decodeBytes: aByteArray - | decoder stream | - stream := aByteArray readStream. - decoder := self decoderFor: stream. - ^decoder decode: stream upToEnd +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizeOptimizing: aCompiledMethod + self optimizingNativizer + method: aCompiledMethod; + nativize ! ! -!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -decodeFromAddress: externalAddress length: anInteger - ^self current - decodeStringFrom: externalAddress readStream - length: anInteger +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizeWithoutOptimizing: aCompiledMethod + | method | + method := self + nativizerDuring: [ :jit | jit nativize: aCompiledMethod ]. + ^method ! ! -!Unicode class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -decoderFor: aStream - (aStream peekForAll: UTF32 prefix) ifTrue: [^UTF32]. - (aStream peekForAll: UTF16 prefix) ifTrue: [^UTF16]. - ^UTF8 +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativizerDuring: aBlock + ^busy + ifFalse: [ + busy := true. + [ aBlock value: cachedNativizer ] ensure: [ busy := false ] ] + ifTrue: [ + | old | + old := cachedNativizer. + [ + cachedNativizer := self newTemplateJIT. + aBlock value: cachedNativizer ] ensure: [ cachedNativizer := old ] ] ! ! -!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -characterIndexOf: aString at: anInteger - (self isDBS: aString upTo: anInteger - 1) ifTrue: [^anInteger]. - ^super characterIndexOf: aString at: anInteger * 2 +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +newAssembler + ^platform newAssembler ! ! -!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -characterIndexesOf: aString from: start to: end - " - UTF16 current characterIndexesOf: '𝑎𝑎𝑎x' from: 3 to: 5 - " - | i e s max n | - aString isWideString ifFalse: [^start thru: end]. - s := i := self characterIndexOf: aString at: start. - n := aString size. - max := end * 2. - e := start * 2. - [i < n and: [e <= max]] whileTrue: [| ch len | - i := i + 1. - ch := aString at: i. - len := self sizeOfCharacter: ch. - e := e + len]. - ^s thru: i - 1 +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +newTemplateJIT + ^TemplateJIT new environment: self ! ! -!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -indexesOf: aString from: start to: end - | e stretch delta | - e := start - 1 max: end - 1. - (self isDBS: aString upTo: e) ifTrue: [ - delta := end > 0 - ifTrue: [self sizeOfCharacter: (aString at: end)] - ifFalse: [0]. - ^start thru: end - 1 + (delta // 2)]. - stretch := super indexesOf: aString from: start to: end. - ^stretch + 1 // 2 +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +optimizingNativizer + ^OptimizingNativizer new environment: self ! ! -!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -isDBS: aString - ^self isDBS: aString upTo: aString size +!NativizationEnvironment methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +sexpressionOffsetsOf: code + | method | + method := code method. + (self shouldOptimize: method) ifTrue: [ ^#( ) ]. + ^self nativizerDuring: [ :nativizer | + method nativeCode ifNotNil: [ method := method copy ]. + nativizer compile: method. + nativizer sexpressionOffsetsOf: code ] ! ! -!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -isDBS: aString upTo: anInteger - aString isWide ifFalse: [^true]. - 2 - to: anInteger * 4 - by: 4 - do: [:i | (aString uShortAtOffset: i) = 0 ifFalse: [^false]]. - ^true +!NativizationEnvironment methodsFor: 'printing & storing' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +printOn: aStream + "append a printed representation of the receiver to the argument, aStream" + + super printOn: aStream. + aStream nextPutAll: '(platform: '. + platform name printOn: aStream. + aStream nextPut: $) ! ! -!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -lengthOf: aString - ^(self encode: aString) size // 2 +!NativizationEnvironment methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shouldInline: aSymbol + ^inlinedMethods anySatisfy: [ :m | m selector = aSymbol ] ! ! -!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -parameterFrom: aString - | strm | - strm := (ByteArray new: aString size + 1 * 2) writeStream. - aString isCharacter - ifTrue: [self encode: aString on: strm] - ifFalse: [aString do: [:char | self encode: char on: strm]]. - strm nextPut: 0; nextPut: 0. - ^strm contents +!NativizationEnvironment methodsFor: 'queries' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +shouldOptimize: method + | selector classname | + selector := method selector. + classname := method classBinding name. + ^optimizedMethods anySatisfy: [:m | m selector = selector and: [ m classBinding name = classname ] ] ! ! -!UTF16 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -sizeInBytesOf: aString - aString isWideString ifFalse: [^aString size + 1 * 2]. - ^super sizeInBytesOf: aString +!NativizationPlatform methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +abi + self ASSERT: abi notNil. + ^ abi ! ! -!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -decodeFrom: aStream - | b1 b2 hi b3 b4 lo | - b1 := aStream nextByte. - b2 := aStream nextByte. - hi := b1 + (b2 bitShift: 8). - b2 < 16rD8 ifTrue: [^hi]. - hi := hi - 16rD800. - hi < 16r400 ifFalse: [^b2 * 256 + b1]. - hi := (hi bitShift: 10) + 16r10000. - b3 := aStream nextByte. - b4 := aStream nextByte. - lo := (b4 bitShift: 8) - 16rDC00 + b3. - ^hi + lo +!NativizationPlatform methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name + self ASSERT: name notNil. + ^ name ! ! -!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -encode: aCharacter on: aStream - | code c20 hi lo | - code := aCharacter codePoint. - code < 128 ifTrue: [ - aStream nextPut: code; nextPut: 0. - ^self]. - code < 16rD800 ifTrue: [ - aStream - nextPut: (code bitAnd: 16rFF); - nextPut: (code bitShift: -8). - ^self]. - code < 16rE000 ifTrue: [self error: 'invalid code point']. - code < 16r10000 ifTrue: [ - aStream - nextPut: (code bitAnd: 16rFF); - nextPut: (code bitShift: -8). - ^self]. - code < 16r110000 ifTrue: [ - c20 := code - 16r10000. - hi := (c20 bitShift: -10) + 16rD800. - lo := (c20 bitAnd: 16r3FF) + 16rDC00. - aStream - nextPut: (hi bitAnd: 16rFF); - nextPut: (hi bitShift: -8); - nextPut: (lo bitAnd: 16rFF); - nextPut: (lo bitShift: -8). - ^self]. - self error: 'invalid code point' +!NativizationPlatform methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +wordSize + self ASSERT: wordSize notNil. + ^ wordSize ! ! -!UTF16 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -sizeOfCharacter: aCharacter - ^aCharacter codePoint < 16r10000 ifTrue: [2] ifFalse: [4] +!NativizationPlatform methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +wordSizeShift + ^ #(0 0 0 2 0 0 0 3) at: self wordSize ! ! -!UTF16 methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -minBytesPerChar - ^2 +!NativizationPlatform methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +abi: anABI + self ASSERT: abi isNil. + self ASSERT: anABI notNil. + + abi := anABI. ! ! -!UTF16 class methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -decodeFromAddress: externalAddress length: anInteger - | stream | - stream := externalAddress readStream readLimit: anInteger * 2. - ^self current decodeStringFrom: stream length: anInteger +!NativizationPlatform methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +codeGeneratorClass: aClass + self ASSERT: codeGeneratorClass isNil. + self ASSERT: aClass notNil. + + codeGeneratorClass := aClass. ! ! -!UTF16 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -prefix - ^#[16rFE 16rFF] +!NativizationPlatform methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +initialize + "super initialize. -- commented since inherited method does nothing" ! ! -!UTF32 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -decode: aByteArray - ^WideString newFrom: aByteArray +!NativizationPlatform methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +name: aString + self ASSERT: name isNil. + self ASSERT: aString notNil. + + name := aString. ! ! -!UTF32 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -encode: aCharacter on: aStream - aStream nextULongPut: aCharacter codePoint +!NativizationPlatform methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +wordSize: anInteger + self ASSERT: wordSize isNil. + self ASSERT:(anInteger == 8 or:[ anInteger == 4]). + + wordSize := anInteger. ! ! -!UTF32 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -prefix - ^#[16rFE 16rFF 0 0] +!NativizationPlatform methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +newAssembler + ^ abi newAssembler platform: self ! ! -!UTF8 methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -accepts: aByteArray - | stream | - stream := aByteArray readStream. - [stream atEnd] whileFalse: [| s | - s := self sizeOfEncoding: stream next. - s = 0 ifTrue: [^false]. - s - 1 timesRepeat: [ - stream atEnd ifTrue: [^false]. - (stream next bitAnd: 0xC0) = 0x80 ifFalse: [^false]]]. - ^true +!NativizationPlatform methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +newCodeGenerator + self ASSERT: codeGeneratorClass notNil. + + ^ codeGeneratorClass new platform: self. ! ! -!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -decode: aByteArray - aByteArray isExternalMemory - ifTrue: [^self class decodeMemory: aByteArray length: aByteArray length]. - 1 - to: aByteArray size - do: [:i | (aByteArray at: i) asInteger > 127 - ifTrue: [^super decode: aByteArray]]. - ^aByteArray asString +!NativizationPlatform methodsFor: 'printing & storing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +printOn: aStream + super printOn:aStream. + aStream nextPut: $(. + name printOn:aStream. + aStream nextPut: $). ! ! -!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -decodeFrom: aStream - | b1 flags count bytes b2 b3 b4 | - b1 := aStream nextByte. - b1 < 128 ifTrue: [^b1]. - flags := b1 bitAnd: 16rF8. - count := self trailing: flags. - count isNil ifTrue: [^b1]. - bytes := aStream peek: count. - bytes size < count ifTrue: [^b1]. - 1 - to: count - do: [:i | ((bytes byteAt: i) bitAnd: 16rC0) = 16r80 ifFalse: [^b1]]. - aStream skip: count. - count = 1 ifTrue: [ - b2 := bytes byteAt: 1. - b1 := b1 bitAnd: 16r1F. - ^(b1 bitShift: 6) + (b2 bitAnd: 16r3F)]. - count = 2 ifTrue: [ - b2 := (bytes byteAt: 1) bitAnd: 16r3F. - b3 := (bytes byteAt: 2) bitAnd: 16r3F. - b1 := b1 bitAnd: 16rF. - ^(b1 bitShift: 12) + (b2 bitShift: 6) + b3]. - b2 := (bytes byteAt: 1) bitAnd: 16r3F. - b3 := (bytes byteAt: 2) bitAnd: 16r3F. - b4 := (bytes byteAt: 3) bitAnd: 16r3F. - b1 := b1 bitAnd: 7. - ^(b1 bitShift: 18) + (b2 bitShift: 12) + (b3 bitShift: 6) + b4 +!NativizationPlatform class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +host + "Return platform for the machine this code is running on." + + | host | + + host := Kernel host. + host = 'x86_64-linux-gnu' ifTrue:[ ^ self x86_64_linux_gnu ]. + host = 'x86_64-darwin' ifTrue:[ ^ self x86_64_darwin ]. + host = 'x86_64-win32' ifTrue:[ ^self x86_64_win32 ]. + + host = 'riscv64-linux-gnu' ifTrue:[ ^ self riscv64_linux_gnu ]. + + self error:'Unssuported host: ', host. ! ! -!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -encode: aString - aString class = String ifTrue: [ - 1 - to: aString size - do: [:i | (aString codeAt: i) < 128 ifFalse: [^super encode: aString]]. - ^aString asByteArray]. - ^super encode: aString +!NativizationPlatform class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +x86_64_darwin + ^ self new + name: 'x86_64-darwin'; + wordSize: 8; + abi: SysVX64ABI new; + codeGeneratorClass: AMD64CodeGenerator; + yourself ! ! -!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -encode: aCharacter on: aStream - | code b1 b2 b3 b4 | - code := aCharacter codePoint. - code < 128 ifTrue: [ - aStream nextBytePut: code. - ^self]. - code < 16r800 ifTrue: [ - b1 := code bitShift: -6. - b1 := b1 bitOr: 16rC0. - b2 := code bitAnd: 16r3F. - b2 := b2 bitOr: 16r80. - aStream nextBytePut: b1; nextBytePut: b2. - ^self]. - code < 16r10000 ifTrue: [ - b1 := code bitShift: -12. - b1 := b1 bitOr: 16rE0. - b2 := code bitShift: -6. - b2 := b2 bitAnd: 16r3F. - b2 := b2 bitOr: 16r80. - b3 := code bitAnd: 16r3F. - b3 := b3 bitOr: 16r80. - aStream - nextBytePut: b1; - nextBytePut: b2; - nextBytePut: b3. - ^self]. - b1 := code bitShift: -18. - b1 := b1 bitOr: 16rF0. - b2 := code bitShift: -12. - b2 := b2 bitAnd: 16r3F. - b2 := b2 bitOr: 16r80. - b3 := code bitShift: -6. - b3 := b3 bitAnd: 16r3F. - b3 := b3 bitOr: 16r80. - b4 := code bitAnd: 16r3F. - b4 := b4 bitOr: 16r80. - aStream - nextBytePut: b1; - nextBytePut: b2; - nextBytePut: b3; - nextBytePut: b4 +!NativizationPlatform class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +x86_64_linux_gnu + ^ self new + name: 'x86_64-linux-gnu'; + wordSize: 8; + abi: SysVX64ABI new; + codeGeneratorClass: AMD64CodeGenerator; + yourself ! ! -!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -encodeCharacter: aCharacter - | code b1 b2 b3 b4 | - code := aCharacter codePoint. - code < 128 ifTrue: [^ByteArray with: code]. - code < 16r800 ifTrue: [ - b1 := code bitShift: -6. - b1 := b1 bitOr: 16rC0. - b2 := code bitAnd: 16r3F. - b2 := b2 bitOr: 16r80. - ^ByteArray with: b1 with: b2]. - code < 16r10000 ifTrue: [ - b1 := code bitShift: -12. - b1 := b1 bitOr: 16rE0. - b2 := code bitShift: -6. - b2 := b2 bitAnd: 16r3F. - b2 := b2 bitOr: 16r80. - b3 := code bitAnd: 16r3F. - b3 := b3 bitOr: 16r80. - ^ByteArray with: b1 with: b2 with: b3]. - b1 := code bitShift: -18. - b1 := b1 bitOr: 16rF0. - b2 := code bitShift: -12. - b2 := b2 bitAnd: 16r3F. - b2 := b2 bitOr: 16r80. - b3 := code bitShift: -6. - b3 := b3 bitAnd: 16r3F. - b3 := b3 bitOr: 16r80. - b4 := code bitAnd: 16r3F. - b4 := b4 bitOr: 16r80. - ^ByteArray with: b1 with: b2 with: b3 with: b4 +!NativizationPlatform class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +x86_64_win32 + ^ self new + name: 'x86_64-win32'; + wordSize: 8; + abi: WinX64ABI new; + codeGeneratorClass: AMD64CodeGenerator; + yourself ! ! -!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -sizeOfCharacter: aCharacter - | code | - code := aCharacter codePoint. - code < 128 ifTrue: [^1]. - code < 16r800 ifTrue: [^2]. - code < 16r10000 ifTrue: [^3]. - ^4 +!ABI methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +is32bits + ^self bits = 32 ! ! -!UTF8 methodsFor: 'encoding / decoding' stamp: 'KenD 28/Jun/2026 13:27:38'! -sizeOfEncoding: code - code < 0x80 ifTrue: [^1]. - code < 0xC0 ifTrue: [^0]. - code < 0xE0 ifTrue: [^2]. - code < 0xF0 ifTrue: [^3]. - code < 0xF8 ifTrue: [^4]. - ^0 +!ABI methodsFor: 'unclassified' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +is64bits + ^self bits = 64 ! ! -!UTF8 methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! -parameterFrom: aString - | strm | - strm := (ByteArray new: aString size + 1) writeStream. - aString isCharacter - ifTrue: [self encode: aString on: strm] - ifFalse: [aString do: [:char | self encode: char on: strm]]. - strm nextPut: 0. - ^strm contents +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regA + ^self subclassResponsibility ! ! -!UTF8 methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -trailing: byte - (byte bitAnd: 2r11100000) = 2r11000000 ifTrue: [^1]. - (byte bitAnd: 2r11110000) = 2r11100000 ifTrue: [^2]. - (byte bitAnd: 2r11111000) = 2r11110000 ifTrue: [^3]. - ^nil +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regE + ^self subclassResponsibility ! ! -!UTF8 class methodsFor: 'testing' stamp: 'KenD 28/Jun/2026 13:27:38'! -accepts: aByteArray - ^self current accepts: aByteArray +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regFP + ^ self subclassResponsibility ! ! -!UTF8 class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -decodeMemory: anExternalMemory length: anInteger - ^Smalltalk os utf8ToWide: anExternalMemory length: anInteger +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regFalse + ^self subclassResponsibility ! ! -!UTF8 class methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! -encodeMemory: anExternalMemory length: anInteger - " - UTF8 encodeMemory: '→' externalCopy length: 2 - " - Smalltalk os wideToUtf8: anExternalMemory length: anInteger +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regG + ^ self subclassResponsibility ! ! -!UTF8 class methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -prefix - ^#[16rEF 16rBB 16rBF] +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regIP + ^self subclassResponsibility ! ! -!ModuleLoader methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:37'! -loadModuleNamed: aString - | classes moduleName moduleSpec moduleClass | - spec := self readModuleSpecNamed: aString. - classes := self classesSortedBySuperclass: spec classes. - moduleName := ('.' split: spec name) last asSymbol. - moduleSpec := spec classes detect: [:cls | cls name = (moduleName , #Module)] ifNone: nil. - moduleSpec ifNil: [ moduleSpec := spec classes detect: [:cls | cls name = (#Module , moduleName)] ifNone: nil]. - moduleSpec - ifNil: [ - moduleClass := Module.] - ifNotNil: [ - moduleClass := self createNewClassFrom: moduleSpec in: nil. - classes remove: moduleSpec ]. - module := self createNewModule: moduleClass. - module name isEmpty ifTrue: [ module name: moduleName asString ]. - classes do: [:c | self createNewClassFrom: c in: module ]. - spec extendedClasses do: [:c | self createExtensionMethodsOf: c ]. - module justLoaded. - Kernel loadedModules at: module name asSymbol put: module. - ^ module +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regM + ^self subclassResponsibility ! ! -!ModuleLoader methodsFor: 'loading' stamp: 'KenD 28/Jun/2026 13:27:37'! -readModuleSpecNamed: aString - | reader | - reader := ModuleSpecReader new. - reader path: '../../modules/', aString. - ^reader read +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regNil + ^self subclassResponsibility ! ! -!ModuleLoader methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:37'! -classesSortedBySuperclass: anArray - | result seen s dfs | - result := OrderedCollection new. - seen := IdentitySet new. - dfs := [ :class | - s := class superclass. - ((anArray includes: s) andNot: [ seen includes: s ]) ifTrue: [ - dfs value: s ]. - result add: class. - seen add: class ]. - anArray do: [ :class | (seen includes: class) ifFalse: [ dfs value: class ] ]. - self ASSERT: result asSet = anArray asSet. - ^ result +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regR + ^self subclassResponsibility ! ! -!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! -createExtensionMethodsOf: aClassSpec - | class metaclass | - class := module namespace at: aClassSpec name asSymbol. - metaclass := class behavior classBinding. - aClassSpec methods do: [ :m | | cm | - cm := self createNewMethod: m in: class. - module ifNotNil: [ module addExtension: cm ] ]. - aClassSpec metaclass methods do: [ :m | | cm | - cm := self createNewMethod: m in: metaclass. - module ifNotNil: [ module addExtension: cm ] ]. - ^ module +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regS + ^self subclassResponsibility ! ! -!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! -createNewClassFrom: aClassSpec in: module - | superclass metaclass class | - superclass := (module ifNil: [ Kernel ]) namespace at: aClassSpec supername asSymbol. - class := Class newSubclassOf: superclass. - metaclass := class class. - class name: aClassSpec name; instVarNames: aClassSpec instVarNames; classVarNames: aClassSpec classVarNames. - aClassSpec methods do: [ :m | self createNewMethod: m in: class ]. - aClassSpec metaclass methods do: [ :m | self createNewMethod: m in: metaclass ]. - module ifNotNil: [ - module addClass: class. - class module: module]. - ^ class +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regSP + ^self subclassResponsibility ! ! -!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! -createNewMethod: aMethodSpec in: aSpecies - | method selector | - method := SCompiler new compile: aMethodSpec sourceCode. - selector := method selector. - method classBinding: aSpecies. - aSpecies methodDictionary at: selector put: method. - aSpecies organization classify: selector under: method category. - ^method +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regT + ^self subclassResponsibility ! ! -!ModuleLoader methodsFor: 'creating' stamp: 'KenD 28/Jun/2026 13:27:37'! -createNewModule: aClass - | module | - module := aClass new. - module bindKernelExports; importRequiredModules. - aClass name !!= #Module ifTrue: [ aClass module: module. module addClass: aClass]. - ^module +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regTrue + ^self subclassResponsibility ! ! -!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! -read - self readMetadata; readClasses; readExtendedClasses. - ^module +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regV + ^self subclassResponsibility ! ! -!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! -readClass: aString - | filename reader definition pointers variable class metasclass stream contents | - filename := path / aString , '.st'. - contents := Kernel readFile: filename. - contents size = 0 ifTrue: [ - filename := path / aString , '.class.st'. - contents := Kernel readFile: filename. - contents size = 0 ifTrue: [ - self error: 'Cannot find file for class ' , aString]]. - stream := InternalReadStream on: contents. - reader := TonelReader on: stream. - [reader read] ensure: [stream close]. - definition := reader definition. - variable := pointers := true. - definition at: #type ifPresent: [:type | - variable := true. - type = #bytes ifTrue: [pointers := false]]. - class := ClassSpec new - module: module; - name: (definition at: #name) asString; - supername: (definition at: #superclass ifAbsent: nil) asString; - ivars: (definition at: #instVars ifAbsent: #()); - cvarNames: (definition at: #classVars ifAbsent: #()); - sharedPools: (definition at: #pools ifAbsent: #()); - isVariable: variable; - isPointers: pointers. - metasclass := MetaclassSpec new - module: module; - instanceClass: class; - ivars: (definition at: #classInstVars ifAbsent: #()). - class metaclass: metasclass. - module addClass: class. - reader methods do: [:m | self readMethod: m] +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regX0 + ^ self subclassResponsibility ! ! -!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! -readClasses - (metadata at: #classes) do: [:name | self readClass: name] +!ABI methodsFor: 'registers - IR' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +regX1 + ^ self subclassResponsibility ! ! -!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! -readExtendedClass: aString +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +closure: anObjectClosure + closure := anObjectClosure +! ! - | filename contents stream reader definition class metaclass | - filename := path / aString , '.st'. - contents := Kernel readFile: filename. - contents size = 0 ifTrue: [ - self error: 'Cannot find file for extended class ' , aString]. - stream := InternalReadStream on: contents. - reader := TonelReader on: stream. - [reader read] ensure: [stream close]. - definition := reader definition. - class := ClassSpec new - module: module; - name: (definition at: #name) asString. - metaclass := MetaclassSpec new module: module; instanceClass: class. - class metaclass: metaclass. - module addClassExtension: class. - reader methods do: [:m | self readMethod: m] +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +exports: aDictionary + exports := aDictionary ! ! -!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! -readExtendedClasses - (metadata at: #extendedClasses ifAbsent: [#()]) - do: [:name | self readExtendedClass: name] +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +image + ^stream contents ! ! -!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! -readMetadata - | stream name classes | - stream := (Kernel readFile: path , '/package.st') readStream. - stream throughAll: 'Package '. - metadata := (STONReader on: stream) parseMap. - name := (metadata at: #name) replace: $- with: Character space. - module name: name asString. - classes := metadata at: #classes. - classes := classes copyWith: name asString, 'Module'. - metadata at: #classes put: classes +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +imports: anIdentityDictionary + imports := anIdentityDictionary ! ! -!ModuleSpecReader methodsFor: 'read' stamp: 'KenD 28/Jun/2026 13:27:38'! -readMethod: aDictionary - | classname selector category class signature body source method | - classname := aDictionary at: #class. - selector := aDictionary at: #selector. - category := aDictionary at: #category. - class := module resolveClass: classname. - class isNil ifTrue: [ - self - error: 'Cannot find class for method ' , classname , ' >> #' - , selector asString]. - signature := aDictionary at: #signature. - body := aDictionary at: #body. - source := signature dosToUnix unixToMac , String cr - , body dosToUnix unixToMac. - method := MethodSpec new - module: module; - classBinding: class; - selector: selector; - category: category; - source: source. - class addMethod: method +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +mapping: aDictionary + mapping := aDictionary +! ! + +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +objects: aCollection + objects := aCollection ! ! -!ModuleSpecReader methodsFor: 'initialization' stamp: 'KenD 28/Jun/2026 13:27:38'! +!Writer methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +stream: aWriteStream + stream := aWriteStream +! ! + +!Writer methodsFor: 'initializing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! initialize - super initialize. - module := ModuleSpec new + stream := '' writeStream. ! ! -!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -module - ^module +!Writer methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +write + self subclassResponsibility ! ! -!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -module: aModuleSpec - module := aModuleSpec +!Writer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +writeTo: aStream + self stream: aStream; write. ! ! -!ModuleSpecReader methodsFor: 'accessing' stamp: 'KenD 28/Jun/2026 13:27:38'! -path: aFilename - path := aFilename +!Writer methodsFor: 'writing' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +writeToFile: filename + filename binaryWriteStreamDo: [ :s | self writeTo: byteStream ] ! ! -!MessageInlinerTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:27:41'! +!MessageInlinerTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! ast: source ^SCompiler new parse: source ! ! -!MessageInlinerTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026 13:27:41'! +!MessageInlinerTest methodsFor: 'helpers' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! cascadeMessagesIn: source | ast cascadeMessages | ast := self ast: source. @@ -10677,7 +23384,7 @@ cascadeMessagesIn: source ^cascadeMessages ! ! -!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testCascadeAndKeywordIsNotInlined "Regression: a keyword cascade message such as `at:put:` must not be inlined." | messages | @@ -10686,7 +23393,7 @@ testCascadeAndKeywordIsNotInlined messages do: [:m | self deny: m isInlined] ! ! -!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testCascadeIfTrueIsNotInlined "Regression: ifTrue: as the first message of a cascade must not be inlined, because the cascade machinery needs the receiver (a Boolean) to receive @@ -10700,7 +23407,7 @@ testCascadeIfTrueIsNotInlined messages do: [:m | self deny: m isInlined] ! ! -!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +!MessageInlinerTest methodsFor: 'tests - cascade' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testCascadeWhileTrueIsNotInlined "Regression: whileTrue: in a cascade must not be inlined either." | messages | @@ -10709,7 +23416,7 @@ testCascadeWhileTrueIsNotInlined messages do: [:m | self deny: m isInlined] ! ! -!MessageInlinerTest methodsFor: 'tests - non-cascade' stamp: 'KenD 28/Jun/2026 13:27:41'! +!MessageInlinerTest methodsFor: 'tests - non-cascade' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testNonCascadeIfTrueIsInlined "Sanity check: outside a cascade, ifTrue: is still inlined as expected." | ast inlined | @@ -10722,13 +23429,13 @@ testNonCascadeIfTrueIsInlined self assert: inlined ! ! -!SmalltalkScannerTest methodsFor: 'setup' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'setup' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! setUp super setUp. scanner := SCompiler new smalltalkScanner ! ! -!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! test0xNotation | node | node := SCompiler new smalltalkParser parseExpression: '0x10'. @@ -10737,7 +23444,7 @@ test0xNotation self assert: node statements first value = 16 ! ! -!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testFloat | node | scanner on: '0.1'. @@ -10754,7 +23461,7 @@ testFloat assert: node source = '0.1e-35' ! ! -!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testInteger | node | scanner on: '0 12 -35'. @@ -10780,7 +23487,7 @@ testInteger assert: node source = '35' ! ! -!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'numbers' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testIntegerRadix | node | scanner on: '16rFA2'. @@ -10791,7 +23498,7 @@ testIntegerRadix assert: node source = '16rFA2' ! ! -!SmalltalkScannerTest methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'arrays' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testArrayStart | node | scanner on: '#()'. @@ -10811,7 +23518,7 @@ testArrayStart assert: node source = '#''hello''' ! ! -!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testBinary | node | scanner on: '- @@ -10846,7 +23553,7 @@ testBinary assert: node source = '~!!|\/%&*+=><' ! ! -!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testCharacter | node | scanner on: '$a$b'. @@ -10862,13 +23569,13 @@ testCharacter assert: node source = '$b' ! ! -!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testEmpty scanner on: ''. self assert: scanner next isEnd ! ! -!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'strings' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testString | node quote | scanner on: '' storeString. @@ -10892,7 +23599,7 @@ testString assert: node source = quote storeString ! ! -!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testBinarySymbol | node | scanner on: '#='. @@ -10903,7 +23610,7 @@ testBinarySymbol assert: node value = #'=' ! ! -!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testDashStartingSymbol | node | scanner on: '#++'. @@ -10932,13 +23639,13 @@ testDashStartingSymbol assert: node source = '#+-' ! ! -!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testNumericSymbol scanner on: '#35'. self assert: scanner next value = '35' asSymbol ! ! -!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'symbols' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testSymbol | node | scanner on: '#-'. @@ -10975,7 +23682,7 @@ testSymbol self assert: node value = 'b'; assert: node source = 'b' ! ! -!SmalltalkScannerTest methodsFor: 'colons' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'colons' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testColon | node | scanner on: ':a'. @@ -10994,7 +23701,7 @@ testColon assert: node source = ':=' ! ! -!SmalltalkScannerTest methodsFor: 'colons' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'colons' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testColon2 | node | scanner on: '::'. @@ -11004,7 +23711,7 @@ testColon2 assert: node source = '::' ! ! -!SmalltalkScannerTest methodsFor: 'comments' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'comments' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testComment | node | scanner on: '"comment"a'. @@ -11031,7 +23738,7 @@ testComment assert: node position = ('a' size + 1) ! ! -!SmalltalkScannerTest methodsFor: 'identifiers' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'identifiers' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testIdentifier | node | scanner on: 'a'. @@ -11060,7 +23767,7 @@ testIdentifier assert: node source = 'a_1b' ! ! -!SmalltalkScannerTest methodsFor: 'identifiers' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'identifiers' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testKeyword | node node2 | scanner on: 'a:'. @@ -11081,7 +23788,7 @@ testKeyword assert: node2 source = 'cd:' ! ! -!SmalltalkScannerTest methodsFor: 'unicode' stamp: 'KenD 28/Jun/2026 13:27:41'! +!SmalltalkScannerTest methodsFor: 'unicode' stamp: 'KenD 28/Jun/2026, 8:27:41 pm (UTC)'! testUnicodeScanning "#knownIssue: depends on Character class>>value: path that resolves UnicodeLibrary, which is not yet defined in the egg Kernel. Re-enable once UnicodeLibrary is ported." @@ -11101,17 +23808,161 @@ testUnicodeScanning self assert: tensor value = 8855 asCharacter asString asSymbol ! ! -!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyFor: aCompiledMethod + ^ NativizationEnvironment forTesting + newTemplateJIT nativize: aCompiledMethod +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForBlock + ^self assemblyForSource: 'foo [1] value' +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForIfTrue + ^self assemblyForSource: 'foo x ifTrue: [1]' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForMessage + ^self assemblyForSource: 'foo self bar' +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForMessageCascade + ^self assemblyForSource: 'foo self bar; baz' +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForMethod: aCompiledMethod + +^ self + assemblyForSource: aCompiledMethod sourceCode + in: aCompiledMethod classBinding value. + +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForPoint_1_plus_y + ^self assemblyForSource: 'foo 1 + y' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForPoint_ret_x_eq_1 + ^ self assemblyForSource: 'foo ^x = 1' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForPoint_x + ^ self assemblyForMethod: Point >> #x +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForPoint_x_eq_1 + ^self assemblyForSource: 'foo x = 1' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForPoint_x_eq_eq_1 + ^self assemblyForSource: 'foo x == 1' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForPoint_x_plus_1 + ^self assemblyForSource: 'foo x + 1' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForPoint_x_plus_y + ^self assemblyForSource: 'foo x + y' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForSource: aString + ^self assemblyForSource: aString in: UndefinedObject +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForSource: aString in: aSpecies + | method | + method := SCompiler compile: aString in: aSpecies. + ^self assemblyFor: method +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForSourceOrig: aString + ^self assemblyForSourceOrig: aString in: UndefinedObject +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForSourceOrig: aString in: aSpecies + | method | + method := SCompiler compile: aString in: aSpecies. + ^self assemblyOrigFor: method +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyForWhileTrue + ^self assemblyForSource: 'foo [x := x + 1. true] whileTrue' in: Point +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +assemblyOrigFor: aCompiledMethod + ^ NativizationEnvironment forTesting nativize: + aCompiledMethod +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodBasicAdd + | source | + source := 'basicAdd: anObject + end = contents size ifTrue: [self makeRoomBehind]. + end := end + 1. + contents at: end put: anObject. + ^anObject'. + ^self methodForSource: source in: OrderedCollection +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodForSource: aString + ^self methodForSource: aString in: UndefinedObject +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodForSource: aString in: aSpecies + | method | + method := SCompiler compile: aString in: aSpecies. + ^self nativize: method +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +methodWithBlock + ^self methodForSource: 'foo [1] value' +! ! + +!TemplateJITTest methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:40 pm (UTC)'! +nativize: aCompiledMethod + ^ NativizationEnvironment forTesting newTemplateJIT + nativize: aCompiledMethod +! ! + +!SOpNonLocalReturn methodsFor: 'visiting' stamp: 'KenD 28/Jun/2026, 8:27:39 pm (UTC)'! +acceptVisitor: visitor + ^ visitor visitOpNonLocalReturn: self +! ! + +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _cachedLookup: aSymbol ^self _cachedLookup: aSymbol in: self behavior ! ! -!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _cachedLookup: aSymbol in: behavior ^GlobalDispatchCache current lookupAndCache: aSymbol in: behavior ! ! -!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _invoke: aNativeCode " senders of _invoke: MUST have at least 1 temporary. The argument of @@ -11124,12 +23975,12 @@ _invoke: aNativeCode ^self _transferControlDiscardingLastArgTo: aNativeCode ! ! -!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _lookup: aSymbol ^self _lookup: aSymbol in: self behavior ! ! -!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _lookup: aSymbol in: behavior | methods cm next | methods := behavior _basicAt: 2. @@ -11139,7 +23990,7 @@ _lookup: aSymbol in: behavior ^next == nil ifFalse: [self _lookup: aSymbol in: next] ! ! -!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _lookup: aSymbol inDictionary: methodDictionary | table | table := methodDictionary _basicAt: 2. @@ -11150,7 +24001,7 @@ _lookup: aSymbol inDictionary: methodDictionary ^nil ! ! -!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'lookup' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! lookupAndInvoke: aSymbol | cm | cm := self _cachedLookup: aSymbol. @@ -11159,82 +24010,82 @@ lookupAndInvoke: aSymbol self _transferControlDiscardingLastArgTo: cm validNativeCodeAddress _asNative ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _flagsMask: mask self _basicFlags: (self _basicFlags bitAnd: mask) ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _flagsSet: mask self _basicFlags: (self _basicFlags bitOr: mask) ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _hasBeenSeen ^(self _basicFlags bitAnd: HasBeenSeen) == HasBeenSeen ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _hasNamedSlots ^(self _basicFlags bitAnd: IsNamed) = IsNamed ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _headerSizeInBytes ^self _isSmall ifTrue: [8] ifFalse: [16] ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _isArrayed ^false == self _isFixed ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _isBytes ^(self _basicFlags bitAnd: IsBytes) = IsBytes ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _isFixed ^(self _basicFlags bitAnd: IsArrayed) == 0 ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _isLarge ^(self _basicFlags bitAnd: IsSmall) == 0 ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _isProxy ^self _hasBeenSeen ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _isRemembered ^(self _basicFlags bitAnd: IsRemembered) = IsRemembered ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _isSecondGeneration ^(self _basicFlags bitAnd: IsSecondGeneration) = IsSecondGeneration ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _isSmall ^(self _basicFlags bitAnd: IsSmall) = IsSmall ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _isSpecial ^(self _basicFlags bitAnd: IsSpecial) = IsSpecial ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _largeSize: size self _basicULongAt: _ExtendedSize put: size _asNative ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _makeExtendedSize: size self _beLarge; @@ -11243,24 +24094,24 @@ _makeExtendedSize: size _basicULongAt: _Reserved put: 0 _asNative ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _nextBasePointer ^self _asPointer + self _sizeInBytes _asPointer ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _objectFromBasePointer | offset | offset := (self _asObject _byteAt: 4) > 127 ifTrue: [8] ifFalse: [16]. ^(self + offset _asPointer) _asObject ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _pointersSize ^self _isBytes ifTrue: [0] ifFalse: [self _size] ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _sizeInBytes | total | total := self _size. @@ -11269,12 +24120,12 @@ _sizeInBytes ifFalse: [total * WordSize] ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _strongPointersSize ^(self _isBytes or: [self _isSpecial]) ifTrue: [0] ifFalse: [0 + self _size] ! ! -!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'header access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! initializeExtended: aBoolean contentSize: size self _basicULongAt: -1 put: 0 _asNative. aBoolean @@ -11286,51 +24137,51 @@ initializeExtended: aBoolean contentSize: size ifFalse: [self _smallSize: size; _beSmall] ! ! -!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _highHalf ^self _oop bitShift: WordSize * 8 // -2 ! ! -!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _low32 ^WordSize > 4 ifTrue: [self bitAnd: 0xFFFFFFFF] ifFalse: [self] ! ! -!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _lowHalf ^self _oop bitAnd: 16rFFFF ! ! -!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _oop ^self _asPointer * 2 ! ! -!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'underprimitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! smallOop ^self _asPointer ! ! -!LMRProtoObject methodsFor: 'raw access' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'raw access' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _uLongAtValidOffset: offset put: anInteger anInteger size > 4 ifTrue: [self error: 'does not fit in 32 bits']. self _primitiveULongAtOffset: offset put: anInteger. ^anInteger ! ! -!LMRProtoObject methodsFor: 'unwinding' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'unwinding' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! _returnTo: aBeeFrame [#forceEnvironment]. aBeeFrame _beCurrent. ^self ! ! -!LMRProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! allReferences ^Memory current collectAndCompactOldSpace; referencesTo: self ! ! -!LMRProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'system' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! perform: aSymbol withArguments: anArray | size | size := anArray basicSize. @@ -11339,12 +24190,12 @@ perform: aSymbol withArguments: anArray ^self lookupAndInvoke: aSymbol ! ! -!LMRProtoObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'services' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! become: anotherObject Memory current make: self become: anotherObject ! ! -!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! doesNotUnderstandSelector: selector | arguments message | arguments := StackFrameCursor top moveNext @@ -11353,7 +24204,7 @@ doesNotUnderstandSelector: selector ^self doesNotUnderstand: message ! ! -!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! holdRefererIfNeeded: referent | memory | #savePreviousSelf. @@ -11364,7 +24215,7 @@ holdRefererIfNeeded: referent ifFalse: [(memory isYoungSafe: self) ifTrue: [memory remember: referent]] ! ! -!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRProtoObject methodsFor: 'private' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! shouldBeInRememberedSet | m | m := Memory current. @@ -11376,7 +24227,7 @@ shouldBeInRememberedSet ^false ! ! -!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! allocate: byteSize size: size | headerSize totalSize buffer object extended | extended := size > 255. @@ -11390,40 +24241,40 @@ allocate: byteSize size: size ^object ! ! -!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! basicNew ^self _instancesAreArrayed ifTrue: [self primitiveNew: 0] ifFalse: [self primitiveNew]! ! -!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! basicNew: anInteger ^self primitiveNew: anInteger ! ! -!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! memory ^Memory current ! ! -!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! new ^self _instancesAreArrayed ifTrue: [self primitiveNew: 0] ifFalse: [self primitiveNew] ! ! -!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! new: anInteger ^self primitiveNew: anInteger ! ! -!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! primitiveNew ^self memory newPointers: instanceBehavior size: self instSize ! ! -!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! primitiveNew: size size _isSmallInteger ifFalse: [self error: 'invalid size']. self _instancesAreArrayed ifFalse: [self errorNotIndexable]. @@ -11432,12 +24283,12 @@ primitiveNew: size ifFalse: [self primitiveNewBytes: size] ! ! -!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! primitiveNewBytes: size ^self memory newArrayedBytes: instanceBehavior size: size ! ! -!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'Primitives' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! primitiveNewPointers: size ^self memory newArrayedPointers: instanceBehavior @@ -11445,13 +24296,14 @@ primitiveNewPointers: size named: self instSize > 0 ! ! -!LMRSpecies methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! nil: size slotsOf: object object _nilSlots: size ! ! -!LMRSpecies methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026 13:27:38'! +!LMRSpecies methodsFor: 'instance creation' stamp: 'KenD 28/Jun/2026, 8:27:38 pm (UTC)'! zero: size bytesOf: object object _zeroSlots: (size bitShift: 0 - WordSizeShift) ! ! SFFIDescriptor initialize! +Assembler initialize!