├── .gdbinit ├── .gitignore ├── CMakeLists.txt ├── LICENSE.txt ├── README.md ├── benchmarks ├── DeltaBlue.st └── Richards.st ├── cityhash ├── city.c └── city.h ├── linenoise ├── linenoise.c └── linenoise.h ├── main.c ├── smalltalk ├── Assert.st ├── AssertError.st ├── Behavior.st ├── Block.st ├── BlockContext.st ├── Boolean.st ├── Class.st ├── ClassDescription.st ├── Collections │ ├── Array.st │ ├── ArrayedCollection.st │ ├── Association.st │ ├── Bag.st │ ├── ByteArray.st │ ├── Collection.st │ ├── Dictionary.st │ ├── HashedCollection.st │ ├── Interval.st │ ├── OrderedCollection.st │ ├── SequenceableCollection.st │ ├── Set.st │ ├── String.st │ └── Symbol.st ├── CompiledBlock.st ├── CompiledCode.st ├── CompiledMethod.st ├── Compiler │ ├── CompileError.st │ ├── Compiler.st │ ├── InvalidPragmaError.st │ ├── ReadonlyVariableError.st │ ├── RedefinitionError.st │ └── UndefinedVariableError.st ├── Context.st ├── ContextCopy.st ├── Debugger.st ├── Error.st ├── Exception.st ├── ExceptionHandler.st ├── False.st ├── FileSourceCode.st ├── GarbageCollector.st ├── IoError.st ├── Iterator.st ├── Magnitudes │ ├── Character.st │ ├── DateTime.st │ ├── Integer.st │ ├── Magnitude.st │ ├── Number.st │ └── SmallInteger.st ├── Message.st ├── MessageNotUnderstood.st ├── MetaClass.st ├── MethodContext.st ├── NotFoundError.st ├── Object.st ├── OutOfRangeError.st ├── Parser │ ├── ArrayNode.st │ ├── BlockNode.st │ ├── BlockScope.st │ ├── CharacterNode.st │ ├── ClassNode.st │ ├── ExpressionNode.st │ ├── FalseNode.st │ ├── IntegerNode.st │ ├── LiteralNode.st │ ├── MessageExpressionNode.st │ ├── MethodNode.st │ ├── NilNode.st │ ├── ParseError.st │ ├── Parser.st │ ├── StringNode.st │ ├── SymbolNode.st │ ├── TrueNode.st │ └── VariableNode.st ├── Processes │ ├── Delay.st │ ├── Process.st │ └── ProcessorScheduler.st ├── Repl.st ├── ShouldNotImplement.st ├── SourceCode.st ├── Streams │ ├── BufferedStream.st │ ├── CollectionStream.st │ ├── ExternalStream.st │ ├── FileStream.st │ ├── InternetAddress.st │ ├── PositionableStream.st │ ├── ServerSocket.st │ ├── Socket.st │ ├── Stream.st │ └── StreamView.st ├── SubClassResponsibility.st ├── True.st ├── TypeFeedback.st ├── UndefinedObject.st └── VMTools.st ├── test ├── tests ├── ArrayTest.st ├── BehaviorTest.st ├── BlockTest.st ├── CharacterTest.st ├── CollectionStreamTest.st ├── CompilerTest.st ├── CompilerTestFile.st ├── ExceptionTest.st ├── NumberTest.st ├── ObjectTest.st ├── OrderedCollectionTest.st ├── OuterReturnTest.st ├── ParserTest.st ├── RegAllocTest.st ├── SmallIntegerTest.st ├── StreamViewTest.st ├── StringTest.st └── UndefinedObjectTest.st └── vm ├── Assembler.h ├── AssemblerX64.h ├── Assert.h ├── Ast.h ├── Bootstrap.c ├── Bootstrap.h ├── Bytecodes.h ├── Class.c ├── Class.h ├── Cli.h ├── CodeDescriptors.h ├── CodeGenerator.h ├── CodeGeneratorX64.c ├── Collection.c ├── Collection.h ├── CompiledCode.c ├── CompiledCode.h ├── Compiler.c ├── Compiler.h ├── Dictionary.c ├── Dictionary.h ├── Entry.c ├── Entry.h ├── Exception.c ├── Exception.h ├── FreeList.c ├── FreeList.h ├── GarbageCollector.c ├── GarbageCollector.h ├── Handle.c ├── Handle.h ├── Heap.c ├── Heap.h ├── HeapPage.c ├── HeapPage.h ├── Iterator.c ├── Iterator.h ├── Lookup.c ├── Lookup.h ├── Object.h ├── Optimizer.c ├── Optimizer.h ├── Os.h ├── OsLinux.c ├── Parser.c ├── Parser.h ├── ParserTest.c ├── Primitives.c ├── Primitives.h ├── PrimitivesX64.c ├── RegisterAllocator.c ├── RegisterAllocator.h ├── RememberedSet.h ├── Repl.c ├── Repl.h ├── Scavenger.c ├── Scavenger.h ├── Scope.c ├── Scope.h ├── Smalltalk.c ├── Smalltalk.h ├── Snapshot.c ├── Snapshot.h ├── Socket.c ├── Socket.h ├── StackFrame.c ├── StackFrame.h ├── Stream.c ├── Stream.h ├── String.c ├── String.h ├── StubCode.h ├── StubCodeX64.c ├── Thread.c ├── Thread.h ├── Tokenizer.c ├── Tokenizer.h ├── TokenizerTest.c └── Variable.h /.gdbinit: -------------------------------------------------------------------------------- 1 | set unwindonsignal on 2 | 3 | define ds 4 | set $code = findNativeCodeAtIc($arg0) 5 | set $method = 0 6 | set $block = 0 7 | set $source = 0 8 | if (((RawObject *) $code->compiledCode)->class == Handles.CompiledMethod->raw) 9 | set $method = (RawCompiledMethod *) $code->compiledCode 10 | set $source = (RawSourceCode *) asObject($method->sourceCode) 11 | else 12 | set $block = (RawCompiledBlock *) $code->compiledCode 13 | set $method = (RawCompiledMethod *) asObject($block->method) 14 | set $source = (RawSourceCode *) asObject($block->sourceCode) 15 | end 16 | set $class = (RawClass *) asObject($method->ownerClass) 17 | set $selector = (RawString *) asObject($method->selector) 18 | printClass $class 19 | printf "#%s ", $selector->contents 20 | if $block 21 | printf "[] " 22 | end 23 | printSourceCode $source 24 | printf "\n" 25 | disassemble $code->insts, $code->insts + $code->size 26 | end 27 | 28 | define rawds 29 | set $code = findNativeCodeAtIc($arg0) 30 | disassemble $code->insts, $code->insts + $code->size 31 | end 32 | 33 | define printClass 34 | set $class = (RawClass *) $arg0 35 | if $class->class == Handles.MetaClass->raw 36 | set $class = (RawClass *) asObject(((RawMetaClass *) $arg0)->instanceClass) 37 | end 38 | set $name = (RawString *) asObject($class->name) 39 | printf "%s", $name->contents 40 | if $arg0->class == Handles.MetaClass->raw 41 | printf " class" 42 | end 43 | end 44 | 45 | define printSourceCode 46 | set $sName = (RawString *) asObject($arg0->sourceOrFileName) 47 | printf "%s:%li:%li", $sName->contents, asCInt($arg0->line), asCInt($arg0->column) 48 | end 49 | 50 | define parentbp 51 | p/x ((Value *) $arg0)[0] 52 | end 53 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.a 3 | *.out 4 | CMakeCache.txt 5 | CMakeFiles 6 | Makefile 7 | cmake_install.cmake 8 | CTestTestfile.cmake 9 | Testing 10 | install_manifest.txt 11 | .gdb_history 12 | history.txt 13 | snapshot 14 | st -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 2.8) 2 | project(myvm) 3 | 4 | #set(CMAKE_BUILD_TYPE "RelWithDebInfo") 5 | #set(CMAKE_BUILD_TYPE "Release") 6 | #set(CMAKE_C_FLAGS "-std=gnu99") 7 | set(CMAKE_BUILD_TYPE "Debug") 8 | set(CMAKE_C_FLAGS "-std=gnu99 -pedantic -Wno-flexible-array-extensions -Wno-c11-extensions -Wno-gnu") 9 | #set(CMAKE_C_FLAGS "-std=gnu99 -pedantic -Wno-flexible-array-extensions -Wno-c11-extensions -fsanitize=undefined") 10 | 11 | set(vmSources 12 | vm/Bootstrap.c 13 | vm/Class.c 14 | vm/CodeGeneratorX64.c 15 | vm/Collection.c 16 | vm/CompiledCode.c 17 | vm/Compiler.c 18 | vm/Dictionary.c 19 | vm/Entry.c 20 | vm/Exception.c 21 | vm/FreeList.c 22 | vm/GarbageCollector.c 23 | vm/Handle.c 24 | vm/Heap.c 25 | vm/HeapPage.c 26 | vm/Iterator.c 27 | vm/Lookup.c 28 | vm/Optimizer.c 29 | vm/OsLinux.c 30 | vm/Parser.c 31 | vm/Primitives.c 32 | vm/RegisterAllocator.c 33 | vm/Repl.c 34 | vm/Scavenger.c 35 | vm/Scope.c 36 | vm/Smalltalk.c 37 | vm/Snapshot.c 38 | vm/Socket.c 39 | vm/StackFrame.c 40 | vm/Stream.c 41 | vm/String.c 42 | vm/StubCodeX64.c 43 | vm/Thread.c 44 | vm/Tokenizer.c 45 | ) 46 | 47 | find_package(Threads) 48 | add_library(CityHash SHARED cityhash/city.c) 49 | add_library(Linenoise SHARED linenoise/linenoise.c) 50 | add_library(VM SHARED ${vmSources}) 51 | add_executable(st main.c) 52 | 53 | target_link_libraries(VM CityHash) 54 | target_link_libraries(VM Linenoise) 55 | target_link_libraries(VM ${CMAKE_THREAD_LIBS_INIT}) 56 | target_link_libraries(st VM) 57 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Ladislav Marek 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, 5 | are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, this 11 | list of conditions and the following disclaimer in the documentation and/or 12 | other materials provided with the distribution. 13 | 14 | * Neither the name of the {organization} nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 22 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 23 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 24 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 25 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 27 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Yet another Smalltalk VM 2 | ======================== 3 | 4 | … is Smalltalk Virtual Machine. It supports Smalltalk as described in Bluebook 5 | and partially ANSI Smalltalk with support for class definiton syntax. 6 | 7 | … is written in C and contains bytecode compiler (used only for compiled code 8 | representation - not interpreted), JIT (currently only x86-64 is supported), 9 | generational GC with moving GC on new space and mark & sweep on old space. 10 | 11 | … is tested on x86-64 Linux, Os X and FreeBSD. 12 | 13 | 14 | Usage 15 | ----- 16 | 17 | For building VM you need: Clang or GCC and Cmake. 18 | 19 | ```sh 20 | # withing VM root directory 21 | cmake . 22 | make all 23 | ./st -b smalltalk # compiles Smalltalk kernel and writes to ./snapshot 24 | ``` 25 | -------------------------------------------------------------------------------- /cityhash/city.h: -------------------------------------------------------------------------------- 1 | // city.h - cityhash-c 2 | // CityHash on C 3 | // Copyright (c) 2011-2012, Alexander Nusov 4 | // 5 | // - original copyright notice - 6 | // Copyright (c) 2011 Google, Inc. 7 | // 8 | // Permission is hereby granted, free of charge, to any person obtaining a copy 9 | // of this software and associated documentation files (the "Software"), to deal 10 | // in the Software without restriction, including without limitation the rights 11 | // to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | // copies of the Software, and to permit persons to whom the Software is 13 | // furnished to do so, subject to the following conditions: 14 | // 15 | // The above copyright notice and this permission notice shall be included in 16 | // all copies or substantial portions of the Software. 17 | // 18 | // THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | // IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | // FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | // AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | // LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | // OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | // THE SOFTWARE. 25 | // 26 | // CityHash, by Geoff Pike and Jyrki Alakuijala 27 | // 28 | // This file provides a few functions for hashing strings. On x86-64 29 | // hardware in 2011, CityHash64() is faster than other high-quality 30 | // hash functions, such as Murmur. This is largely due to higher 31 | // instruction-level parallelism. CityHash64() and CityHash128() also perform 32 | // well on hash-quality tests. 33 | // 34 | // CityHash128() is optimized for relatively long strings and returns 35 | // a 128-bit hash. For strings more than about 2000 bytes it can be 36 | // faster than CityHash64(). 37 | // 38 | // Functions in the CityHash family are not suitable for cryptography. 39 | // 40 | // WARNING: This code has not been tested on big-endian platforms! 41 | // It is known to work well on little-endian platforms that have a small penalty 42 | // for unaligned reads, such as current Intel and AMD moderate-to-high-end CPUs. 43 | // 44 | // By the way, for some hash functions, given strings a and b, the hash 45 | // of a+b is easily derived from the hashes of a and b. This property 46 | // doesn't hold for any hash functions in this file. 47 | 48 | #ifndef CITY_HASH_H_ 49 | #define CITY_HASH_H_ 50 | 51 | #include 52 | #include 53 | 54 | typedef uint8_t uint8; 55 | typedef uint32_t uint32; 56 | typedef uint64_t uint64; 57 | 58 | typedef struct _uint128 uint128; 59 | struct _uint128 { 60 | uint64 first; 61 | uint64 second; 62 | }; 63 | 64 | #define Uint128Low64(x) (x).first 65 | #define Uint128High64(x) (x).second 66 | 67 | // Hash function for a byte array. 68 | uint64 CityHash64(const char *buf, size_t len); 69 | 70 | // Hash function for a byte array. For convenience, a 64-bit seed is also 71 | // hashed into the result. 72 | uint64 CityHash64WithSeed(const char *buf, size_t len, uint64 seed); 73 | 74 | // Hash function for a byte array. For convenience, two seeds are also 75 | // hashed into the result. 76 | uint64 CityHash64WithSeeds(const char *buf, size_t len, 77 | uint64 seed0, uint64 seed1); 78 | 79 | // Hash function for a byte array. 80 | uint128 CityHash128(const char *s, size_t len); 81 | 82 | // Hash function for a byte array. For convenience, a 128-bit seed is also 83 | // hashed into the result. 84 | uint128 CityHash128WithSeed(const char *s, size_t len, uint128 seed); 85 | 86 | #endif // CITY_HASH_H_ 87 | 88 | -------------------------------------------------------------------------------- /linenoise/linenoise.h: -------------------------------------------------------------------------------- 1 | /* linenoise.h -- guerrilla line editing library against the idea that a 2 | * line editing lib needs to be 20,000 lines of C code. 3 | * 4 | * See linenoise.c for more information. 5 | * 6 | * ------------------------------------------------------------------------ 7 | * 8 | * Copyright (c) 2010, Salvatore Sanfilippo 9 | * Copyright (c) 2010, Pieter Noordhuis 10 | * 11 | * All rights reserved. 12 | * 13 | * Redistribution and use in source and binary forms, with or without 14 | * modification, are permitted provided that the following conditions are 15 | * met: 16 | * 17 | * * Redistributions of source code must retain the above copyright 18 | * notice, this list of conditions and the following disclaimer. 19 | * 20 | * * Redistributions in binary form must reproduce the above copyright 21 | * notice, this list of conditions and the following disclaimer in the 22 | * documentation and/or other materials provided with the distribution. 23 | * 24 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 | * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 27 | * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 28 | * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 29 | * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 30 | * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 31 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 32 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 33 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 34 | * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 35 | */ 36 | 37 | #ifndef __LINENOISE_H 38 | #define __LINENOISE_H 39 | 40 | #include 41 | 42 | typedef struct linenoiseCompletions { 43 | size_t len; 44 | char **cvec; 45 | } linenoiseCompletions; 46 | 47 | typedef void(linenoiseCompletionCallback)(const char *, linenoiseCompletions *); 48 | void linenoiseSetCompletionCallback(linenoiseCompletionCallback *); 49 | void linenoiseAddCompletion(linenoiseCompletions *, char *); 50 | 51 | char *linenoise(const char *prompt); 52 | int linenoiseHistoryAdd(const char *line); 53 | int linenoiseHistorySetMaxLen(int len); 54 | int linenoiseHistorySave(char *filename); 55 | int linenoiseHistoryLoad(char *filename); 56 | void linenoiseClearScreen(void); 57 | void linenoiseSetMultiLine(int ml); 58 | 59 | #endif /* __LINENOISE_H */ 60 | -------------------------------------------------------------------------------- /main.c: -------------------------------------------------------------------------------- 1 | #include "vm/Bootstrap.h" 2 | #include "vm/Snapshot.h" 3 | #include "vm/Entry.h" 4 | #include "vm/Repl.h" 5 | #include "vm/Thread.h" 6 | #include "vm/Cli.h" 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | static void bootstrapSmalltalk(char *snapshotFileName, char *bootstrapDir); 13 | 14 | 15 | int main(int argc, char **args) 16 | { 17 | CliArgs cliArgs; 18 | int result = EXIT_SUCCESS; 19 | 20 | parseCliArgs(&cliArgs, argc, args); 21 | initThread(&CurrentThread); 22 | bootstrapSmalltalk(cliArgs.snapshotFileName, cliArgs.bootstrapDir); 23 | 24 | if (cliArgs.error != NULL) { 25 | printf(cliArgs.error, cliArgs.operand); 26 | printf("\n"); 27 | result = EXIT_FAILURE; 28 | } else if (cliArgs.printHelp) { 29 | printCliHelp(); 30 | } else if (cliArgs.fileName != NULL) { 31 | Value blockResult; 32 | if (parseFileAndInitialize(cliArgs.fileName, &blockResult)) { 33 | result = valueTypeOf(blockResult, VALUE_INT) ? asCInt(blockResult) : result; 34 | } else { 35 | result = EXIT_FAILURE; 36 | } 37 | } else if (cliArgs.eval != NULL) { 38 | result = asCInt(evalCode(cliArgs.eval)); 39 | } else { 40 | runRepl(); 41 | } 42 | 43 | freeHandles(); 44 | freeThread(&CurrentThread); 45 | return result; 46 | } 47 | 48 | 49 | 50 | static void bootstrapSmalltalk(char *snapshotFileName, char *bootstrapDir) 51 | { 52 | FILE *snapshot; 53 | if (bootstrapDir) { 54 | snapshot = fopen(snapshotFileName, "w+"); 55 | if (snapshot == NULL) { 56 | printf("Cannot write to snapshot file: '%s'\n", snapshotFileName); 57 | exit(EXIT_FAILURE); 58 | } 59 | if (!bootstrap(bootstrapDir)) { 60 | printf("Bootstrap failed\n"); 61 | exit(EXIT_FAILURE); 62 | } 63 | snapshotWrite(snapshot); 64 | } else { 65 | snapshot = fopen(snapshotFileName, "r"); 66 | if (snapshot == NULL) { 67 | printf("Cannot read snapshot file: '%s'\n", snapshotFileName); 68 | exit(EXIT_FAILURE); 69 | } 70 | snapshotRead(snapshot); 71 | } 72 | fclose(snapshot); 73 | } 74 | -------------------------------------------------------------------------------- /smalltalk/Assert.st: -------------------------------------------------------------------------------- 1 | Assert := Object [ 2 | 3 | class true: aBool [ 4 | aBool ifFalse: [AssertError expected: true got: aBool]. 5 | ] 6 | 7 | 8 | class false: aBool [ 9 | aBool ifTrue: [AssertError expected: false got: aBool]. 10 | ] 11 | 12 | 13 | class do: aBlock expect: aClass [ 14 | | signaled | 15 | 16 | [signaled := true. 17 | aBlock value. 18 | signaled := false] on: aClass do: [ :e | ]. 19 | 20 | signaled ifFalse: [AssertError expected: aClass got: nil]. 21 | ] 22 | 23 | ] 24 | -------------------------------------------------------------------------------- /smalltalk/AssertError.st: -------------------------------------------------------------------------------- 1 | AssertError := Error [ 2 | 3 | | expected actual | 4 | 5 | 6 | class expected: anObject got: anActualObject [ 7 | ^(self new initializeExpected: anObject actual: anActualObject) signal 8 | ] 9 | 10 | 11 | initializeExpected: anObject actual: anActualObject [ 12 | expected := anObject. 13 | actual := anActualObject. 14 | ] 15 | 16 | 17 | defaultMessageText [ 18 | ^'Failed assertion: expected ', expected printString, ' but got ', actual printString 19 | ] 20 | 21 | ] 22 | -------------------------------------------------------------------------------- /smalltalk/Behavior.st: -------------------------------------------------------------------------------- 1 | Behavior := Object [ 2 | 3 | | superClass subClasses methodDictionary instanceShape instanceVariables | 4 | 5 | 6 | "instance creation" 7 | 8 | new [ 9 | 10 | ] 11 | 12 | 13 | new: anInteger [ 14 | 15 | (anInteger isMemberOf: SmallInteger) ifFalse: [Error signal: 'size must be SmallInteger']. 16 | Error signal. 17 | ] 18 | 19 | 20 | basicNew [ 21 | 22 | ] 23 | 24 | 25 | basicNew: anInteger [ 26 | 27 | Error signal. 28 | ] 29 | 30 | 31 | "shape and size" 32 | 33 | instanceSize [ 34 | ^(instanceShape bitShift: -14) bitAnd: 16rFF 35 | ] 36 | 37 | 38 | instanceShape [ 39 | ^instanceShape 40 | ] 41 | 42 | 43 | isIndexable [ 44 | ^((instanceShape bitShift: -22) bitAnd: 16rFF) = 1 45 | ] 46 | 47 | 48 | instanceVariables [ 49 | ^instanceVariables isNil ifTrue: [#()] ifFalse: [instanceVariables] 50 | ] 51 | 52 | 53 | "accessing class hierarchy" 54 | 55 | superClass [ 56 | ^superClass 57 | ] 58 | 59 | 60 | subClasses [ 61 | ^subClasses 62 | ] 63 | 64 | 65 | methodDictionary [ 66 | ^methodDictionary 67 | ] 68 | 69 | 70 | "testing class hierarchy" 71 | 72 | inheritsFrom: aClass [ 73 | | aSuperClass | 74 | 75 | aSuperClass := superClass. 76 | [aSuperClass == nil] whileFalse: [ 77 | aSuperClass == aClass ifTrue: [^true]. 78 | aSuperClass := aSuperClass superClass]. 79 | ^false 80 | ] 81 | 82 | 83 | "accessing the method dictionary" 84 | 85 | selectors [ 86 | ^methodDictionary keys 87 | ] 88 | 89 | 90 | allSelectors [ 91 | | selectors | 92 | 93 | selectors := self selectors. 94 | self allSuperClassesDo: [ :class | selectors addAll: class selectors]. 95 | ^selectors 96 | ] 97 | 98 | 99 | lookupSelector: aSymbol [ 100 | | class | 101 | 102 | class := self. 103 | [class methodDictionary at: aSymbol ifPresent: [ :code | ^code]. 104 | (class := class superClass) isNil] whileFalse. 105 | ^nil 106 | ] 107 | 108 | 109 | compiledMethodAt: aSymbol [ 110 | ^methodDictionary at: aSymbol 111 | ] 112 | 113 | 114 | "testing method dictionary" 115 | 116 | canUnderstand: aSymbol [ 117 | (self includesSelector: aSymbol) ifTrue: [^true]. 118 | superClass == nil ifTrue: [^false]. 119 | ^superClass canUnderstand: aSymbol 120 | ] 121 | 122 | 123 | includesSelector: aSymbol [ 124 | ^methodDictionary includesKey: aSymbol 125 | ] 126 | 127 | 128 | "enumerating" 129 | 130 | allSuperClassesDo: aBlock [ 131 | | class | 132 | 133 | class := self. 134 | [(class := class superClass) notNil] whileTrue: [ 135 | aBlock value: class]. 136 | ] 137 | 138 | 139 | allSubClassesDo: aBlock [ 140 | self subClasses do: [ :aClass | 141 | aBlock value: aClass. 142 | aClass allSubClassesDo: aBlock]. 143 | ] 144 | 145 | 146 | "printing" 147 | 148 | printHierarchy [ 149 | Transcript nextPutAll: self name; lf. 150 | self printSubClassesOn: Transcript level: 1. 151 | ] 152 | 153 | 154 | printSubClassesOn: aStream level: anInteger [ 155 | self subClasses do: [ :aClass | 156 | Transcript 157 | next: anInteger put: Character space; 158 | nextPutAll: aClass name; 159 | lf. 160 | aClass printSubClassesOn: aStream level: anInteger + 1]. 161 | ] 162 | 163 | ] 164 | -------------------------------------------------------------------------------- /smalltalk/Block.st: -------------------------------------------------------------------------------- 1 | Block := Object [ 2 | 3 | 4 | 5 | | compiledBlock receiver outerContext homeContext | 6 | 7 | 8 | "accessing" 9 | 10 | compiledBlock [ 11 | ^compiledBlock 12 | ] 13 | 14 | 15 | receiver [ 16 | ^receiver 17 | ] 18 | 19 | 20 | outerContext [ 21 | ^outerContext 22 | ] 23 | 24 | 25 | homeContext [ 26 | ^homeContext 27 | ] 28 | 29 | 30 | "evaluating" 31 | 32 | value [ 33 | 34 | OutOfRangeError signal. 35 | ] 36 | 37 | 38 | value: arg [ 39 | 40 | OutOfRangeError signal. 41 | ] 42 | 43 | 44 | value: arg1 value: arg2 [ 45 | 46 | OutOfRangeError signal. 47 | ] 48 | 49 | 50 | value: arg1 value: arg2 value: arg3 [ 51 | 52 | OutOfRangeError signal. 53 | ] 54 | 55 | 56 | valueWithArguments: anArray [ 57 | 58 | OutOfRangeError signal. 59 | ] 60 | 61 | 62 | "controlling" 63 | 64 | whileTrue: aBlock [ 65 | 66 | Error signal: self printString, ' must return a ', Boolean printString. 67 | ] 68 | 69 | 70 | whileFalse: aBlock [ 71 | [self value not] whileTrue: aBlock. 72 | ] 73 | 74 | 75 | whileTrue [ 76 | 77 | Error signal: self printString, ' must return a ', Boolean printString. 78 | ] 79 | 80 | 81 | whileFalse [ 82 | [self value not] whileTrue. 83 | ] 84 | 85 | 86 | repeat [ 87 | [self value. true] whileTrue. 88 | ] 89 | 90 | 91 | on: anException do: aBlock [ 92 | 93 | ] 94 | 95 | 96 | on: anException do: aBlock on: anException2 do: aBlock2 [ 97 | ^[self on: anException do: aBlock] on: anException2 do: aBlock2. 98 | ] 99 | 100 | 101 | on: anException do: aBlock on: anException2 do: aBlock2 on: anException3 do: aBlock3 [ 102 | ^[[self on: anException do: aBlock] on: anException2 do: aBlock2] on: anException3 do: aBlock3. 103 | ] 104 | 105 | 106 | "schedulling" 107 | 108 | fork [ 109 | Error signal. 110 | ] 111 | 112 | 113 | newProcess [ 114 | Error signal. 115 | ] 116 | 117 | ] 118 | -------------------------------------------------------------------------------- /smalltalk/BlockContext.st: -------------------------------------------------------------------------------- 1 | BlockContext := Context [ 2 | 3 | "accessing" 4 | 5 | block [ 6 | ^self code 7 | ] 8 | 9 | ] 10 | 11 | -------------------------------------------------------------------------------- /smalltalk/Boolean.st: -------------------------------------------------------------------------------- 1 | Boolean := Object [ 2 | 3 | "logical operations" 4 | 5 | & aBoolean [ 6 | SubClassResponsibility signal. 7 | ] 8 | 9 | 10 | not [ 11 | SubClassResponsibility signal. 12 | ] 13 | 14 | 15 | xor: aBoolean [ 16 | ^(self == aBoolean) not 17 | ] 18 | 19 | 20 | | aBoolean [ 21 | SubClassResponsibility signal. 22 | ] 23 | 24 | 25 | "controlling" 26 | 27 | ifTrue: aBlock [ 28 | SubClassResponsibility signal. 29 | ] 30 | 31 | 32 | ifFalse: aBlock [ 33 | SubClassResponsibility signal. 34 | ] 35 | 36 | 37 | ifTrue: aTrueBlock ifFalse: aFalseBlock [ 38 | SubClassResponsibility signal. 39 | ] 40 | 41 | 42 | ifFalse: aFalseBlock ifTrue: aTrueBlock [ 43 | SubClassResponsibility signal. 44 | ] 45 | 46 | 47 | and: aBlock [ 48 | SubClassResponsibility signal. 49 | ] 50 | 51 | 52 | or: aBlock [ 53 | SubClassResponsibility signal. 54 | ] 55 | 56 | 57 | "copying" 58 | 59 | deepCopy [ 60 | ^self 61 | ] 62 | 63 | 64 | shallowCopy [ 65 | ^self 66 | ] 67 | 68 | ] 69 | -------------------------------------------------------------------------------- /smalltalk/Class.st: -------------------------------------------------------------------------------- 1 | Class := ClassDescription [ 2 | 3 | | name comment category classVariables | 4 | 5 | 6 | "accessing" 7 | 8 | name [ 9 | ^name 10 | ] 11 | 12 | 13 | classVariables [ 14 | ^classVariables 15 | ] 16 | 17 | 18 | initialize [ 19 | 20 | ] 21 | 22 | 23 | "printing" 24 | 25 | printOn: aStream [ 26 | aStream nextPutAll: name. 27 | ] 28 | 29 | ] 30 | -------------------------------------------------------------------------------- /smalltalk/ClassDescription.st: -------------------------------------------------------------------------------- 1 | ClassDescription := Behavior [ 2 | 3 | ] 4 | -------------------------------------------------------------------------------- /smalltalk/Collections/Array.st: -------------------------------------------------------------------------------- 1 | Array := ArrayedCollection [ 2 | 3 | ] 4 | -------------------------------------------------------------------------------- /smalltalk/Collections/ArrayedCollection.st: -------------------------------------------------------------------------------- 1 | ArrayedCollection := SequenceableCollection [ 2 | 3 | 4 | 5 | 6 | "instance creation" 7 | 8 | class with: anObject [ 9 | ^(self new: 1) at: 1 put: anObject; yourself 10 | ] 11 | 12 | 13 | class with: anObject with: anObject2 [ 14 | ^(self new: 2) 15 | at: 1 put: anObject; 16 | at: 2 put: anObject2; 17 | yourself 18 | ] 19 | 20 | 21 | "accessing" 22 | 23 | size [ 24 | ^self basicSize 25 | ] 26 | 27 | 28 | "adding" 29 | 30 | add: anObject [ 31 | ShouldNotImplement signal. 32 | ] 33 | 34 | ] 35 | -------------------------------------------------------------------------------- /smalltalk/Collections/Association.st: -------------------------------------------------------------------------------- 1 | Association := Object [ 2 | 3 | | key value | 4 | 5 | 6 | "instance creation" 7 | 8 | class key: key value: value [ 9 | ^self new key: key value: value 10 | ] 11 | 12 | 13 | "initialization" 14 | 15 | key: aKey value: aValue [ 16 | key := aKey. 17 | value := aValue. 18 | ] 19 | 20 | 21 | "accessing" 22 | 23 | key [ 24 | ^key 25 | ] 26 | 27 | 28 | value [ 29 | ^value 30 | ] 31 | 32 | 33 | value: anObject [ 34 | value := anObject. 35 | ] 36 | 37 | 38 | "printing" 39 | 40 | printOn: aStream [ 41 | key == self ifTrue: [aStream nextPutAll: '(recursion)'] ifFalse: [key basicPrintOn: aStream]. 42 | aStream nextPutAll: '->'. 43 | value == self ifTrue: [aStream nextPutAll: '(recursion)'] ifFalse: [value basicPrintOn: aStream]. 44 | ] 45 | 46 | ] 47 | -------------------------------------------------------------------------------- /smalltalk/Collections/Bag.st: -------------------------------------------------------------------------------- 1 | Bag := Collection [ 2 | 3 | 4 | 5 | | contents | 6 | 7 | 8 | "instance creation" 9 | 10 | class new [ 11 | ^self new: 31 12 | ] 13 | 14 | 15 | class new: anInteger [ 16 | ^self basicNew initialize: anInteger 17 | ] 18 | 19 | 20 | "initialization" 21 | 22 | initialize: anInteger [ 23 | contents := Dictionary new: anInteger. 24 | ] 25 | 26 | 27 | "testing" 28 | 29 | includes: anObject [ 30 | ^contents includesKey: anObject 31 | ] 32 | 33 | 34 | occurrencesOf: anObject [ 35 | ^contents at: anObject ifAbsent: [0] 36 | ] 37 | 38 | 39 | "adding" 40 | 41 | add: anObject [ 42 | ^self add: anObject withOccurrences: 1 43 | ] 44 | 45 | 46 | add: anObject withOccurrences: anInteger [ 47 | (self includes: anObject) 48 | ifTrue: [contents at: anObject put: (self occurrencesOf: anObject) + anInteger] 49 | ifFalse: [contents at: anObject put: anInteger]. 50 | ^anObject 51 | ] 52 | 53 | 54 | "removing" 55 | 56 | remove: anObject ifAbsent: aBlock [ 57 | | count | 58 | 59 | count := contents at: anObject ifAbsent: [^aBlock value]. 60 | count = 1 61 | ifTrue: [contents removeKey: anObject] 62 | ifFalse: [contents at: anObject put: count - 1]. 63 | ^anObject 64 | ] 65 | 66 | 67 | "enumerating" 68 | 69 | do: aBlock [ 70 | contents associationsDo: [ :assoc | assoc value timesRepeat: [aBlock value: assoc key]]. 71 | ] 72 | 73 | ] 74 | -------------------------------------------------------------------------------- /smalltalk/Collections/ByteArray.st: -------------------------------------------------------------------------------- 1 | ByteArray := ArrayedCollection [ 2 | 3 | 4 | 5 | ] 6 | -------------------------------------------------------------------------------- /smalltalk/Collections/Collection.st: -------------------------------------------------------------------------------- 1 | Collection := Iterator [ 2 | 3 | "accessing" 4 | 5 | size [ 6 | | tally | 7 | 8 | tally := 0. 9 | self do: [ :each | tally := tally + 1]. 10 | ^tally 11 | ] 12 | 13 | 14 | "testing" 15 | 16 | includes: anObject [ 17 | self do: [ :v | v = anObject ifTrue: [^true]]. 18 | ^false 19 | ] 20 | 21 | 22 | includesAnyOf: aCollection [ 23 | ^self anySatisfy: [ :v | aCollection includes: v] 24 | ] 25 | 26 | 27 | isEmpty [ 28 | ^self size = 0 29 | ] 30 | 31 | 32 | occurrencesOf: anObject [ 33 | | tally | 34 | 35 | tally := 0. 36 | self do: [ :v | v = anObject ifTrue: [tally := tally + 1]]. 37 | ^tally 38 | ] 39 | 40 | 41 | "adding" 42 | 43 | add: anObject [ 44 | SubClassResponsibility signal. 45 | ] 46 | 47 | 48 | addAll: aCollection [ 49 | aCollection do: [ :v | self add: v]. 50 | ^aCollection 51 | ] 52 | 53 | 54 | "removing" 55 | 56 | remove: anObject [ 57 | ^self remove: anObject ifAbsent: [(NotFoundError value: anObject) signal] 58 | ] 59 | 60 | 61 | remove: anObject ifAbsent: aBlock [ 62 | SubClassResponsibility signal. 63 | ] 64 | 65 | 66 | removeAll: aCollection [ 67 | aCollection do: [ :v | self remove: v]. 68 | ^aCollection 69 | ] 70 | 71 | 72 | "private" 73 | 74 | emptyCheck [ 75 | self isEmpty ifTrue: [OutOfRangeError signal]. 76 | ] 77 | 78 | 79 | "printing" 80 | 81 | printOn: aStream [ 82 | | items | 83 | 84 | super printOn: aStream. 85 | 86 | items := 0. 87 | aStream nextPutAll: ' ('. 88 | self do: [ :v | 89 | (items := items + 1) = 7 ifTrue: [ 90 | aStream nextPutAll: '...)'. 91 | ^self]. 92 | v == self 93 | ifTrue: [aStream nextPutAll: 'self(recursion)'] 94 | ifFalse: [v basicPrintOn: aStream]. 95 | aStream space]. 96 | aStream nextPut: $). 97 | ] 98 | 99 | ] 100 | -------------------------------------------------------------------------------- /smalltalk/Collections/Dictionary.st: -------------------------------------------------------------------------------- 1 | Dictionary := HashedCollection [ 2 | 3 | "instance creation" 4 | 5 | class new [ 6 | ^self new: 31 7 | ] 8 | 9 | 10 | "accessing" 11 | 12 | at: key [ 13 | ^self at: key ifAbsent: [(NotFoundError value: key) signal] 14 | ] 15 | 16 | 17 | at: key ifAbsent: aBlock [ 18 | | index | 19 | 20 | index := self findIndex: key ifAbsent: [^aBlock value]. 21 | ^(contents at: index) value 22 | ] 23 | 24 | 25 | at: key ifPresent: aBlock [ 26 | | index | 27 | 28 | index := self findIndex: key ifAbsent: [^nil]. 29 | ^aBlock value: (contents at: index) value 30 | ] 31 | 32 | 33 | at: key put: anObject [ 34 | | index | 35 | 36 | index := self findIndex: key. 37 | (contents at: index) isNil 38 | ifTrue: [self atNewIndex: index put: key -> anObject] 39 | ifFalse: [(contents at: index) value: anObject]. 40 | 41 | ^anObject 42 | ] 43 | 44 | 45 | keyAtValue: anObject [ 46 | ^self keyAtValue: anObject ifAbsent: [(NotFoundError value: anObject) signal] 47 | ] 48 | 49 | 50 | keyAtValue: anObject ifAbsent: aBlock [ 51 | self associationsDo: [ :assoc | assoc value == anObject ifTrue: [^assoc key]]. 52 | ^aBlock value 53 | ] 54 | 55 | 56 | keys [ 57 | | keys | 58 | 59 | keys := Set new: self size. 60 | self keysDo: [ :key | keys add: key]. 61 | ^keys 62 | ] 63 | 64 | 65 | values [ 66 | | values | 67 | 68 | values := Bag new: self size. 69 | self do: [ :value | values add: value]. 70 | ^values 71 | ] 72 | 73 | 74 | "adding" 75 | 76 | add: anAssociation [ 77 | | index assoc | 78 | 79 | index := self findIndex: anAssociation key. 80 | assoc := contents at: index. 81 | 82 | assoc isNil 83 | ifTrue: [ 84 | self atNewIndex: index put: anAssociation. 85 | ^anAssociation] 86 | ifFalse: [ 87 | assoc value: anAssociation value. 88 | ^assoc]. 89 | ] 90 | 91 | 92 | "removing" 93 | 94 | remove: anAssociation ifAbsent: aBlock [ 95 | self removeKey: anAssociation key ifAbsent: aBlock. 96 | ^anAssociation 97 | ] 98 | 99 | 100 | removeKey: anObject [ 101 | ^self removeKey: anObject ifAbsent: [(NotFoundError value: anObject) signal] 102 | ] 103 | 104 | 105 | removeKey: anObject ifAbsent: aBlock [ 106 | | index assoc | 107 | 108 | index := self findIndex: anObject ifAbsent: [^aBlock value]. 109 | assoc := contents at: index. 110 | contents at: index put: nil. 111 | tally := tally - 1. 112 | ^assoc value 113 | ] 114 | 115 | 116 | "enumerating" 117 | 118 | do: aBlock [ 119 | contents do: [ :assoc | assoc notNil ifTrue: [aBlock value: assoc value]]. 120 | ] 121 | 122 | 123 | "dictionary enumerating" 124 | 125 | associationsDo: aBlock [ 126 | super do: aBlock. 127 | ] 128 | 129 | 130 | keysDo: aBlock [ 131 | self associationsDo: [ :assoc | aBlock value: assoc key]. 132 | ] 133 | 134 | 135 | keysAndValuesDo: aBlock [ 136 | self associationsDo: [ :assoc | aBlock value: assoc key value: assoc value]. 137 | ] 138 | 139 | 140 | "testing" 141 | 142 | includesKey: anObject [ 143 | ^super includes: anObject 144 | ] 145 | 146 | 147 | includes: anObject [ 148 | self do: [ :element | element = anObject ifTrue: [^true]]. 149 | ^false 150 | ] 151 | 152 | 153 | "private" 154 | 155 | findIndex: anObject [ 156 | | size index assoc | 157 | 158 | size := contents size. 159 | index := (anObject hash bitAnd: size - 1) + 1. 160 | 161 | [assoc := contents at: index. 162 | (assoc isNil or: [assoc key = anObject]) ifTrue: [^index]. 163 | index := index == size ifTrue: [1] ifFalse: [index + 1]] 164 | repeat. 165 | ] 166 | 167 | 168 | "printing" 169 | 170 | printOn: aStream [ 171 | | items | 172 | 173 | super basicPrintOn: aStream. 174 | 175 | items := 0. 176 | aStream nextPutAll: ' ('. 177 | self associationsDo: [ :v | 178 | (items := items + 1) = 7 ifTrue: [ 179 | aStream nextPutAll: '...)'. 180 | ^self]. 181 | v value == self 182 | ifTrue: [ 183 | v key basicPrintOn: aStream. 184 | aStream nextPutAll: '->self(recursion)'] 185 | ifFalse: [ 186 | v printOn: aStream]. 187 | aStream space]. 188 | aStream nextPut: $). 189 | ] 190 | 191 | ] 192 | -------------------------------------------------------------------------------- /smalltalk/Collections/HashedCollection.st: -------------------------------------------------------------------------------- 1 | HashedCollection := Collection [ 2 | 3 | | contents tally | 4 | 5 | 6 | "instance creation" 7 | 8 | class new: anInteger [ 9 | | collection | 10 | 11 | collection := super new. 12 | collection initialize: (self computeSize: anInteger). 13 | ^collection 14 | ] 15 | 16 | 17 | class computeSize: anInteger [ 18 | | size | 19 | 20 | size := 8 max: (anInteger * 4 + 2) // 3. 21 | (size bitAnd: size - 1) = 0 ifFalse: [ 22 | size := size - 1. 23 | size := size bitOr: (size bitShift: -1). 24 | size := size bitOr: (size bitShift: -2). 25 | size := size bitOr: (size bitShift: -4). 26 | size := size bitOr: (size bitShift: -8). 27 | size := size bitOr: (size bitShift: -16). 28 | size := size + 1]. 29 | ^size 30 | ] 31 | 32 | 33 | "initialization" 34 | 35 | initialize: anInteger [ 36 | contents := Array new: anInteger. 37 | tally := 0. 38 | ] 39 | 40 | 41 | "accesing" 42 | 43 | size [ 44 | ^tally 45 | ] 46 | 47 | 48 | at: key [ 49 | SubClassResponsibility signal. 50 | ] 51 | 52 | 53 | at: key put: anObject [ 54 | SubClassResponsibility signal. 55 | ] 56 | 57 | 58 | atNewIndex: anInteger put: anObject [ 59 | contents at: anInteger put: anObject. 60 | tally := tally + 1. 61 | tally = contents size ifTrue: [self grow]. 62 | ] 63 | 64 | 65 | "adding" 66 | 67 | grow [ 68 | | oldContents | 69 | 70 | oldContents := contents. 71 | self initialize: oldContents size * 2. 72 | oldContents do: [ :item | self add: item]. 73 | ] 74 | 75 | 76 | "removing" 77 | 78 | remove: anObject ifAbsent: aBlock [ 79 | | index | 80 | 81 | index := self findIndex: anObject ifAbsent: [^aBlock value]. 82 | contents at: index put: nil. 83 | tally := tally - 1. 84 | "TODO: shrink contents array?" 85 | ^anObject 86 | ] 87 | 88 | 89 | "enumerating" 90 | 91 | do: aBlock [ 92 | contents do: [ :item | item notNil ifTrue: [aBlock value: item]]. 93 | ] 94 | 95 | 96 | "testing" 97 | 98 | includes: anObject [ 99 | self findIndex: anObject ifAbsent: [^false]. 100 | ^true 101 | ] 102 | 103 | 104 | "private" 105 | 106 | findIndex: anObject ifAbsent: aBlock [ 107 | | index | 108 | 109 | index := self findIndex: anObject. 110 | (contents at: index) isNil ifTrue: [aBlock value]. 111 | ^index 112 | ] 113 | 114 | 115 | findIndex: anObject [ 116 | SubClassResponsibility signal. 117 | ] 118 | 119 | 120 | "printing" 121 | 122 | examineOn: aStream [ 123 | super examineOn: aStream. 124 | self associationsDo: [ :v | 125 | aStream nextPutAll: ' - '. 126 | v == self 127 | ifTrue: [aStream nextPutAll: 'self (recursion)'] 128 | ifFalse: [v printOn: aStream]. 129 | aStream lf]. 130 | ] 131 | 132 | ] 133 | -------------------------------------------------------------------------------- /smalltalk/Collections/Interval.st: -------------------------------------------------------------------------------- 1 | Interval := ArrayedCollection [ 2 | 3 | 4 | 5 | | start stop step | 6 | 7 | 8 | "instance creation" 9 | 10 | class from: start to: stop [ 11 | ^self new initializeFrom: start to: stop by: 1 12 | ] 13 | 14 | 15 | class from: start to: stop by: step [ 16 | ^self new initializeFrom: start to: stop by: step 17 | ] 18 | 19 | 20 | "initializing" 21 | 22 | initializeFrom: aStart to: aStop by: aStep [ 23 | start := aStart. 24 | stop := aStop. 25 | step := aStep. 26 | ] 27 | 28 | 29 | "acessing" 30 | 31 | at: anInteger [ 32 | (anInteger >= 1 and: [anInteger <= self size]) ifTrue: [ 33 | ^start + (step * (anInteger - 1))]. 34 | OutOfRangeError signal. 35 | ] 36 | 37 | 38 | at: anInteger put: anObject [ 39 | Error signal. 40 | ] 41 | 42 | 43 | first [ 44 | ^start 45 | ] 46 | 47 | 48 | increment [ 49 | ^step 50 | ] 51 | 52 | 53 | last [ 54 | ^stop - (stop - start \\ step) 55 | ] 56 | 57 | 58 | size [ 59 | step < 0 ifTrue: [ 60 | start < stop ifTrue: [^0]. 61 | ^stop - start // step + 1]. 62 | stop < start ifTrue: [^0]. 63 | ^stop - start // step + 1 64 | ] 65 | 66 | 67 | "comparing" 68 | 69 | = anObject [ 70 | ^self class == anObject class and: [start = anObject first 71 | and: [step = anObject increment and: [self size = anObject size]]]. 72 | ] 73 | 74 | 75 | hash [ 76 | ^(((start hash bitShift: 2) bitOr: stop hash) bitShift: 1) bitOr: self size 77 | ] 78 | 79 | 80 | "adding" 81 | 82 | add: anObject [ 83 | ShouldNotImplement signal. 84 | ] 85 | 86 | 87 | "removing" 88 | 89 | remove: anObject [ 90 | ShouldNotImplement signal. 91 | ] 92 | 93 | 94 | "enumerating" 95 | 96 | collect: aBlock [ 97 | | collection index | 98 | 99 | collection := Array new: self size. 100 | index := 0. 101 | start to: stop by: step do: [ :i | 102 | collection at: (index := index + 1) put: (aBlock value: i)]. 103 | ^collection 104 | ] 105 | 106 | 107 | do: aBlock [ 108 | start to: stop by: step do: aBlock. 109 | ] 110 | 111 | 112 | reverseDo: aBlock [ 113 | stop to: start by: step negated do: aBlock. 114 | ] 115 | 116 | ] 117 | -------------------------------------------------------------------------------- /smalltalk/Collections/Set.st: -------------------------------------------------------------------------------- 1 | Set := HashedCollection [ 2 | 3 | "instance creation" 4 | 5 | class new [ 6 | ^self new: 31 7 | ] 8 | 9 | 10 | "accessing" 11 | 12 | add: anObject [ 13 | | index | 14 | 15 | anObject isNil ifTrue: [^anObject]. 16 | index := self findIndex: anObject. 17 | (contents at: index) isNil ifTrue: [self atNewIndex: index put: anObject]. 18 | ^anObject 19 | ] 20 | 21 | 22 | "private" 23 | 24 | findIndex: anObject [ 25 | | size index object | 26 | 27 | size := contents size. 28 | index := (anObject hash bitAnd: size - 1) + 1. 29 | 30 | [object := contents at: index. 31 | (object isNil or: [object = anObject]) ifTrue: [^index]. 32 | index := index == size ifTrue: [1] ifFalse: [index + 1]] 33 | repeat. 34 | ] 35 | 36 | ] 37 | -------------------------------------------------------------------------------- /smalltalk/Collections/String.st: -------------------------------------------------------------------------------- 1 | String := ArrayedCollection [ 2 | 3 | 4 | 5 | 6 | "comparing" 7 | 8 | hash [ 9 | 10 | ] 11 | 12 | 13 | "= aCollection [ 14 | 15 | ]" 16 | 17 | 18 | "converting" 19 | 20 | asSymbol [ 21 | 22 | ] 23 | 24 | 25 | asLowercase [ 26 | | newString | 27 | 28 | newString := self class new: self size. 29 | 1 to: self size do: [ :i | newString at: i put: (self at: i) asLowercase]. 30 | ^newString 31 | ] 32 | 33 | 34 | asNumber [ 35 | ^Number readFrom: (CollectionStream on: self) 36 | ] 37 | 38 | 39 | trimSeparators [ 40 | 1 to: self size do: [ :start | 41 | (self at: start) isSeparator ifFalse: [ 42 | self size to: start by: -1 do: [ :stop | 43 | (self at: stop) isSeparator ifFalse: [ 44 | ^self copyFrom: start to: stop 45 | ]. 46 | ]. 47 | ]. 48 | ]. 49 | ^'' 50 | ] 51 | 52 | 53 | "primitives" 54 | 55 | isKeyword [ 56 | ^self size > 1 and: [self last = $:] 57 | ] 58 | 59 | 60 | keywords [ 61 | | keywords pos | 62 | 63 | keywords := OrderedCollection new. 64 | pos := 1. 65 | 66 | self keysAndValuesDo: [ :i :ch | 67 | ch = $: ifTrue: [ 68 | keywords add: (self copyFrom: pos to: i). 69 | pos := i + 1]. 70 | ]. 71 | keywords isEmpty ifTrue: [keywords add: self]. 72 | ^keywords 73 | ] 74 | 75 | 76 | "printing" 77 | 78 | printOn: aStream [ 79 | aStream 80 | nextPut: $'; 81 | nextPutAll: self; 82 | nextPut: $'. 83 | ] 84 | 85 | ] 86 | -------------------------------------------------------------------------------- /smalltalk/Collections/Symbol.st: -------------------------------------------------------------------------------- 1 | Symbol := String [ 2 | 3 | "comparing" 4 | 5 | hash [ 6 | 7 | ] 8 | 9 | 10 | = anObject [ 11 | ^self == anObject 12 | ] 13 | 14 | 15 | "converting" 16 | 17 | asSymbol [ 18 | 19 | ] 20 | 21 | 22 | "printing" 23 | 24 | printOn: aStream [ 25 | aStream 26 | nextPut: $#; 27 | nextPutAll: self. 28 | ] 29 | 30 | ] 31 | -------------------------------------------------------------------------------- /smalltalk/CompiledBlock.st: -------------------------------------------------------------------------------- 1 | CompiledBlock := CompiledCode [ 2 | 3 | | method sourceCode descriptors | 4 | 5 | 6 | "accessing" 7 | 8 | method [ 9 | ^method 10 | ] 11 | 12 | 13 | sourceCode [ 14 | ^sourceCode 15 | ] 16 | 17 | 18 | descriptors [ 19 | ^descriptors 20 | ] 21 | 22 | 23 | literals [ 24 | ^method literals 25 | ] 26 | 27 | 28 | ownerClass [ 29 | ^method ownerClass 30 | ] 31 | 32 | 33 | "printing" 34 | 35 | printOn: aStream [ 36 | | index | 37 | 38 | method printOn: aStream. 39 | aStream nextPutAll: '[]'. 40 | ] 41 | 42 | ] 43 | -------------------------------------------------------------------------------- /smalltalk/CompiledCode.st: -------------------------------------------------------------------------------- 1 | CompiledCode := Object [ 2 | 3 | 4 | 5 | | header | 6 | 7 | 8 | "accessing" 9 | 10 | header [ 11 | ^header 12 | ] 13 | 14 | 15 | argumentsSize [ 16 | ^(header bitShift: -6) bitAnd: 16rFF 17 | ] 18 | 19 | 20 | temporariesSize [ 21 | ^(header bitShift: -14) bitAnd: 16rFF 22 | ] 23 | 24 | 25 | hasContext [ 26 | ^((header bitShift: -22) bitAnd: 16rFF) = 1 27 | ] 28 | 29 | 30 | outerReturns [ 31 | ^((header bitShift: -36) bitAnd: 16rFF) = 1 32 | ] 33 | 34 | 35 | primitive [ 36 | | primitive | 37 | primitive := (header bitShift: -46) bitAnd: 16rFFFF. 38 | ^primitive = 0 ifTrue: [] ifFalse: [primitive - 1] 39 | ] 40 | 41 | 42 | sourceNode [ 43 | ^(Parser parseString: self sourceCode sourceContents) parseMethodOrBlock 44 | ] 45 | 46 | 47 | temporaries [ 48 | ^self sourceNode temporaries collect: [ :temporary | temporary name] 49 | ] 50 | 51 | 52 | arguments [ 53 | ^self sourceNode arguments collect: [ :argument | argument name] 54 | ] 55 | 56 | 57 | 58 | "printing" 59 | 60 | printInstructionsOn: aStream [ 61 | | insts | 62 | 63 | insts := CollectionStream on: self. 64 | [insts atEnd] whileFalse: [ 65 | aStream nextPut: $<. 66 | insts position printOn: aStream. 67 | aStream nextPut: $>; nextPut: Character tab. 68 | self printInstruction: insts on: aStream]. 69 | ] 70 | 71 | 72 | printInstruction: anInstStream on: aStream [ 73 | | inst | 74 | 75 | inst := anInstStream next. 76 | 77 | inst = 0 ifTrue: [ 78 | aStream nextPutAll: 'copy: '. 79 | self printOperand: anInstStream on: aStream. 80 | aStream nextPutAll: ' to: '. 81 | self printOperand: anInstStream on: aStream]. 82 | 83 | (inst = 1 or: [inst = 2]) ifTrue: [ | args | 84 | aStream nextPutAll: 'send: '. 85 | (self literals at: anInstStream next + 1) printOn: aStream. 86 | args := anInstStream next. 87 | aStream nextPutAll: ' to: '. 88 | self printOperand: anInstStream on: aStream. 89 | args timesRepeat: [ 90 | aStream nextPutAll: ' arg: '. 91 | self printOperand: anInstStream on: aStream]. 92 | inst = 2 ifTrue: [ 93 | aStream nextPutAll: ' storeIn: '. 94 | self printOperand: anInstStream on: aStream]]. 95 | 96 | inst = 3 ifTrue: [ 97 | aStream nextPutAll: 'return: '. 98 | self printOperand: anInstStream on: aStream]. 99 | 100 | inst = 4 ifTrue: [ 101 | aStream nextPutAll: 'returnToOuter: '. 102 | self printOperand: anInstStream on: aStream]. 103 | 104 | aStream lf. 105 | ] 106 | 107 | 108 | printOperand: anInstStream on: aStream [ 109 | | operand | 110 | 111 | operand := anInstStream next. 112 | operand = 0 ifTrue: [ 113 | 8 timesRepeat: [anInstStream next printOn: aStream]. 114 | ^anInstStream]. 115 | 116 | operand = 1 ifTrue: [ 117 | ^aStream nextPutAll: 'nil']. 118 | 119 | operand = 2 ifTrue: [ 120 | ^aStream nextPutAll: 'true']. 121 | 122 | operand = 3 ifTrue: [ 123 | ^aStream nextPutAll: 'false']. 124 | 125 | operand = 4 ifTrue: [ 126 | ^aStream nextPutAll: 'thisContext']. 127 | 128 | operand = 5 ifTrue: [ 129 | aStream nextPutAll: 'tmp#'. 130 | ^anInstStream next printOn: aStream]. 131 | 132 | operand = 6 ifTrue: [ | index | 133 | index := anInstStream next. 134 | index = 1 135 | ifTrue: [ 136 | aStream nextPutAll: 'self'] 137 | ifFalse: [ 138 | aStream nextPutAll: 'arg#'. 139 | index - 1 printOn: aStream]]. 140 | 141 | operand = 7 ifTrue: [ 142 | ^aStream nextPutAll: 'super']. 143 | 144 | operand = 8 ifTrue: [ 145 | aStream nextPutAll: 'ctx#'. 146 | anInstStream next printOn: aStream. 147 | aStream nextPut: $[. 148 | anInstStream next printOn: aStream. 149 | ^aStream nextPut: $]]. 150 | 151 | operand = 9 ifTrue: [ 152 | aStream nextPutAll: 'inst#'. 153 | ^anInstStream next printOn: aStream]. 154 | 155 | operand = 10 ifTrue: [ 156 | aStream nextPutAll: 'inst#'. 157 | anInstStream next printOn: aStream, 158 | aStream nextPutAll: 'of '. 159 | ^self printOperand: anInstStream on: aStream]. 160 | 161 | (operand = 11 or: [operand = 12 or: [operand = 13]]) ifTrue: [ 162 | (self literals at: anInstStream next + 1) printOn: aStream. 163 | ^anInstStream]. 164 | ] 165 | 166 | ] 167 | -------------------------------------------------------------------------------- /smalltalk/CompiledMethod.st: -------------------------------------------------------------------------------- 1 | CompiledMethod := CompiledCode [ 2 | 3 | | literals selector ownerClass sourceCode descriptors | 4 | 5 | 6 | "accessing" 7 | 8 | literals [ 9 | ^literals 10 | ] 11 | 12 | 13 | selector [ 14 | ^selector 15 | ] 16 | 17 | 18 | ownerClass [ 19 | ^ownerClass 20 | ] 21 | 22 | 23 | sourceCode [ 24 | ^sourceCode 25 | ] 26 | 27 | 28 | descriptors [ 29 | ^descriptors 30 | ] 31 | 32 | 33 | sendTo: anObject [ 34 | 35 | ] 36 | 37 | 38 | sendTo: anObject withArguments: anArray [ 39 | 40 | Error signal. 41 | ] 42 | 43 | 44 | "printing" 45 | 46 | printOn: aStream [ 47 | ownerClass basicPrintOn: aStream. 48 | selector printOn: aStream. 49 | ] 50 | 51 | ] 52 | -------------------------------------------------------------------------------- /smalltalk/Compiler/CompileError.st: -------------------------------------------------------------------------------- 1 | CompileError := Error [ 2 | 3 | | identifier | 4 | 5 | ] 6 | -------------------------------------------------------------------------------- /smalltalk/Compiler/Compiler.st: -------------------------------------------------------------------------------- 1 | Compiler := Object [ 2 | 3 | includeFile: aString [ 4 | | stream parser classes | 5 | stream := FileStream read: aString. 6 | parser := Parser parseStream: stream. 7 | classes := OrderedCollection new. 8 | [parser atEnd] whileFalse: [ 9 | classes add: (self buildClass: parser parseClass)]. 10 | classes do: [ :class | class initialize]. 11 | stream close. 12 | ] 13 | 14 | 15 | buildClass: aClassNode [ 16 | | result | 17 | 18 | result := self basicBuildClass: aClassNode. 19 | (result isKindOf: Exception) ifTrue: [result signal]. 20 | ^result 21 | ] 22 | 23 | 24 | basicBuildClass: aClassNode [ 25 | 26 | ] 27 | 28 | 29 | compileMethod: aMethodNode in: aClass [ 30 | | result | 31 | 32 | result := self basicCompileMethod: aMethodNode in: aClass. 33 | (result isKindOf: Exception) ifTrue: [result signal]. 34 | ^result 35 | ] 36 | 37 | 38 | basicCompileMethod: aMethodNode in: aClass [ 39 | 40 | ] 41 | 42 | 43 | evaluate: aString [ 44 | | node method | 45 | 46 | node := (Parser parseString: 'eval [', aString, ']') parseMethod. 47 | node body expressions isEmpty ifFalse: [node body expressions last enableReturn]. 48 | method := self compileMethod: node in: UndefinedObject. 49 | ^method sendTo: nil 50 | ] 51 | 52 | 53 | evaluate: aString withArguments: aDictionary [ 54 | | node method args i | 55 | 56 | node := (Parser parseString: 'eval [', aString, ']') parseMethod. 57 | node body expressions isEmpty ifFalse: [node body expressions last enableReturn]. 58 | 59 | args := Array new: aDictionary size. 60 | i := 1. 61 | aDictionary keysAndValuesDo: [ :name :value | 62 | node body arguments add: (VariableNode value: name). 63 | args at: i put: value. 64 | i := i + 1]. 65 | 66 | method := self compileMethod: node in: UndefinedObject. 67 | ^method sendTo: nil withArguments: args 68 | ] 69 | 70 | ] 71 | -------------------------------------------------------------------------------- /smalltalk/Compiler/InvalidPragmaError.st: -------------------------------------------------------------------------------- 1 | InvalidPragmaError := CompileError [ 2 | 3 | ] 4 | -------------------------------------------------------------------------------- /smalltalk/Compiler/ReadonlyVariableError.st: -------------------------------------------------------------------------------- 1 | ReadonlyVariableError := CompileError [ 2 | 3 | "accessing" 4 | 5 | defaultMessageText [ 6 | | sourceCode | 7 | 8 | sourceCode := identifier sourceCode. 9 | ^'Cannot write to readonly variable: ', 10 | identifier value, 11 | ' in ''', sourceCode source, 12 | ''' line ', sourceCode line printString, 13 | ' column ', sourceCode column printString 14 | ] 15 | 16 | ] 17 | -------------------------------------------------------------------------------- /smalltalk/Compiler/RedefinitionError.st: -------------------------------------------------------------------------------- 1 | RedefinitionError := CompileError [ 2 | 3 | "accessing" 4 | 5 | defaultMessageText [ 6 | | sourceCode | 7 | 8 | sourceCode := identifier sourceCode. 9 | ^'Cannot redefine: ', 10 | identifier value, 11 | ' in ''', sourceCode source, 12 | ''' line ', sourceCode line printString, 13 | ' column ', sourceCode column printString 14 | ] 15 | 16 | ] 17 | -------------------------------------------------------------------------------- /smalltalk/Compiler/UndefinedVariableError.st: -------------------------------------------------------------------------------- 1 | UndefinedVariableError := CompileError [ 2 | 3 | "accessing" 4 | 5 | defaultMessageText [ 6 | | sourceCode | 7 | 8 | sourceCode := identifier sourceCode. 9 | ^'Undefined variable: ', 10 | identifier value, 11 | ' in ''', sourceCode source, 12 | ''' line ', sourceCode line printString, 13 | ' column ', sourceCode column printString 14 | ] 15 | 16 | ] 17 | -------------------------------------------------------------------------------- /smalltalk/Context.st: -------------------------------------------------------------------------------- 1 | Context := Object [ 2 | 3 | 4 | 5 | | ic code parent outer home | 6 | 7 | 8 | "accessing" 9 | 10 | parent [ 11 | 12 | ] 13 | 14 | 15 | ic [ 16 | ^ic 17 | ] 18 | 19 | 20 | code [ 21 | ^code 22 | ] 23 | 24 | 25 | outer [ 26 | ^outer 27 | ] 28 | 29 | 30 | home [ 31 | ^home 32 | ] 33 | 34 | 35 | line [ 36 | ^((self positionDescriptor bitShift: -30) bitAnd: 16rFFFF) + code sourceCode line 37 | ] 38 | 39 | 40 | column [ 41 | ^(self positionDescriptor bitShift: -14) bitAnd: 16rFFFF 42 | ] 43 | 44 | 45 | positionDescriptor [ 46 | 47 | ] 48 | 49 | 50 | size [ 51 | ShouldNotImplement signal. 52 | ] 53 | 54 | 55 | argumentAt: anInteger [ 56 | 57 | ] 58 | 59 | 60 | arguments [ 61 | | arguments | 62 | 63 | arguments := Array new: code argumentsSize. 64 | 1 to: arguments size do: [ :i | arguments at: i put: (self argumentAt: i)]. 65 | ^arguments 66 | ] 67 | 68 | 69 | temporaryAt: anInteger [ 70 | 71 | ] 72 | 73 | 74 | temporaries [ 75 | | temporaries | 76 | 77 | temporaries := Array new: code temporariesSize. 78 | 1 to: temporaries size do: [ :i | temporaries at: i put: (self temporaryAt: i)]. 79 | ^temporaries 80 | ] 81 | 82 | 83 | receiver [ 84 | ^self argumentAt: 0 85 | ] 86 | 87 | 88 | copy [ 89 | ^ContextCopy fromContext: self 90 | ] 91 | 92 | 93 | "printing" 94 | 95 | printOn: aStream [ 96 | self code printOn: aStream. 97 | ] 98 | 99 | 100 | printBacktrace [ 101 | self printBacktraceOn: Transcript. 102 | ] 103 | 104 | 105 | printBacktraceOn: aStream [ 106 | | context i | 107 | 108 | context := self. 109 | i := 1. 110 | 111 | [i printOn: aStream. 112 | aStream nextPutAll: '. '. 113 | context printOn: aStream. 114 | aStream 115 | nextPutAll: ' ... '; 116 | nextPutAll: context code sourceCode source; 117 | nextPut: $:. 118 | context line printOn: aStream. 119 | aStream nextPut: $:. 120 | context column printOn: aStream. 121 | aStream lf. 122 | context := context parent. 123 | i := i + 1. 124 | context isNil] 125 | whileFalse. 126 | ] 127 | 128 | 129 | examineOn: aStream [ 130 | super examineOn: aStream. 131 | aStream nextPutAll: ' receiver: '. 132 | self receiver printOn: aStream. 133 | aStream lf; nextPutAll: ' arguments: '. 134 | self arguments printOn: aStream. 135 | aStream lf; nextPutAll: ' temporaries: '. 136 | self temporaries printOn: aStream. 137 | aStream lf. 138 | ] 139 | 140 | ] 141 | -------------------------------------------------------------------------------- /smalltalk/ContextCopy.st: -------------------------------------------------------------------------------- 1 | ContextCopy := Context [ 2 | 3 | | receiver arguments temporaries | 4 | 5 | 6 | class fromContext: aContex [ 7 | ^self new initializeFromContext: aContex 8 | ] 9 | 10 | 11 | initializeFromContext: aContext [ 12 | ic := aContext ic. 13 | code := aContext code. 14 | outer := aContext outer. 15 | home := aContext home. 16 | receiver := aContext receiver. 17 | arguments := aContext arguments. 18 | temporaries := aContext temporaries. 19 | ] 20 | 21 | 22 | argumentAt: anInteger [ 23 | ^arguments at: anInteger 24 | ] 25 | 26 | 27 | arguments [ 28 | ^arguments 29 | ] 30 | 31 | 32 | temporaryAt: anInteger [ 33 | ^temporaries at: anInteger 34 | ] 35 | 36 | 37 | temporaries [ 38 | ^temporaries 39 | ] 40 | 41 | 42 | receiver [ 43 | ^receiver 44 | ] 45 | 46 | 47 | examineOn: aStream [ 48 | | instVars | 49 | 50 | instVars := self class instanceVariables. 51 | 52 | self basicPrintOn: aStream. 53 | aStream lf. 54 | 55 | 1 to: instVars size do: [ :i | 56 | aStream 57 | space; 58 | nextPutAll: (instVars at: i); 59 | nextPutAll: ': '. 60 | (self instVarAt: i) == self 61 | ifTrue: [aStream nextPutAll: 'self (recursion)'] 62 | ifFalse: [(self instVarAt: i) printOn: aStream]. 63 | aStream lf]. 64 | ] 65 | 66 | ] 67 | -------------------------------------------------------------------------------- /smalltalk/Debugger.st: -------------------------------------------------------------------------------- 1 | Debugger := Object [ 2 | 3 | class break [ 4 | 5 | ] 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /smalltalk/Error.st: -------------------------------------------------------------------------------- 1 | Error := Exception [ 2 | 3 | ] 4 | -------------------------------------------------------------------------------- /smalltalk/Exception.st: -------------------------------------------------------------------------------- 1 | Exception := Object [ 2 | 3 | | messageText | 4 | 5 | 6 | "instance creation" 7 | 8 | class signal [ 9 | self new signal. 10 | ] 11 | 12 | 13 | class signal: aString [ 14 | self new 15 | messageText: aString; 16 | signal. 17 | ] 18 | 19 | 20 | "exception handling" 21 | 22 | class handles: anException [ 23 | ^anException isKindOf: self 24 | ] 25 | 26 | 27 | signal [ 28 | 29 | self defaultAction. 30 | ] 31 | 32 | 33 | defaultAction [ 34 | Transcript nextPutAll: self messageText; lf. 35 | self signalingContext printBacktrace. 36 | Processor thisProcess terminate. 37 | ] 38 | 39 | 40 | "backtrace" 41 | 42 | generateBacktrace [ 43 | | context backtrace | 44 | 45 | backtrace := OrderedCollection new: 8. 46 | context := self signalingContext. 47 | 48 | [backtrace add: context copy. 49 | context := context parent. 50 | context notNil] 51 | whileTrue. 52 | 53 | ^backtrace 54 | ] 55 | 56 | 57 | signalingContext [ 58 | | context | 59 | 60 | context := thisContext. 61 | [(context code ownerClass == Exception or: [context code ownerClass inheritsFrom: Exception]) 62 | or: [context code ownerClass == Exception class or: [context code ownerClass inheritsFrom: Exception class]]] 63 | whileTrue: [context := context parent]. 64 | 65 | ^context 66 | ] 67 | 68 | 69 | "accessing" 70 | 71 | messageText: aString [ 72 | messageText := aString. 73 | ] 74 | 75 | 76 | messageText [ 77 | ^messageText isNil ifTrue: [self defaultMessageText] ifFalse: [messageText] 78 | ] 79 | 80 | 81 | defaultMessageText [ 82 | ^self class name 83 | ] 84 | 85 | ] 86 | -------------------------------------------------------------------------------- /smalltalk/ExceptionHandler.st: -------------------------------------------------------------------------------- 1 | ExceptionHandler := Object [ 2 | 3 | 4 | 5 | | parent context | 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /smalltalk/False.st: -------------------------------------------------------------------------------- 1 | False := Boolean [ 2 | 3 | "logical operations" 4 | 5 | & aBoolean [ 6 | ^self 7 | ] 8 | 9 | 10 | not [ 11 | ^true 12 | ] 13 | 14 | 15 | | aBoolean [ 16 | ^aBoolean 17 | ] 18 | 19 | 20 | "controlling" 21 | 22 | ifTrue: aBlock [ 23 | ^nil 24 | ] 25 | 26 | 27 | ifFalse: aBlock [ 28 | ^aBlock value 29 | ] 30 | 31 | 32 | ifTrue: aTrueBlock ifFalse: aFalseBlock [ 33 | ^aFalseBlock value 34 | ] 35 | 36 | 37 | ifFalse: aFalseBlock ifTrue: aTrueBlock [ 38 | ^aFalseBlock value 39 | ] 40 | 41 | 42 | and: aBlock [ 43 | ^self 44 | ] 45 | 46 | 47 | or: aBlock [ 48 | ^aBlock value 49 | ] 50 | 51 | 52 | "printing" 53 | 54 | printOn: aStream [ 55 | aStream nextPutAll: 'false'. 56 | ] 57 | 58 | ] 59 | -------------------------------------------------------------------------------- /smalltalk/FileSourceCode.st: -------------------------------------------------------------------------------- 1 | FileSourceCode := SourceCode [ 2 | 3 | "accessing" 4 | 5 | sourceContents [ 6 | | stream | 7 | 8 | stream := FileStream read: self source. 9 | stream position: self position. 10 | ^stream next: self sourceSize 11 | ] 12 | 13 | ] 14 | -------------------------------------------------------------------------------- /smalltalk/GarbageCollector.st: -------------------------------------------------------------------------------- 1 | GarbageCollector := Object [ 2 | 3 | class collectGarbage [ 4 | 5 | ] 6 | 7 | 8 | class printHeap [ 9 | 10 | ] 11 | 12 | 13 | class lastStats [ 14 | 15 | ] 16 | 17 | ] 18 | -------------------------------------------------------------------------------- /smalltalk/IoError.st: -------------------------------------------------------------------------------- 1 | IoError := Error [ 2 | 3 | "instance creation" 4 | 5 | class last [ 6 | 7 | ] 8 | 9 | 10 | appendName: aString [ 11 | | stream | 12 | 13 | stream := CollectionStream with: (String new: self messageText size + 3 + aString size). 14 | stream nextPutAll: self messageText; 15 | nextPut: Character space. 16 | aString printOn: stream. 17 | self messageText: stream contents. 18 | ] 19 | 20 | ] 21 | -------------------------------------------------------------------------------- /smalltalk/Iterator.st: -------------------------------------------------------------------------------- 1 | Iterator := Object [ 2 | 3 | "enumerating" 4 | 5 | do: aBlock [ 6 | SubClassResponsibility signal. 7 | ] 8 | 9 | 10 | select: aBlock [ 11 | SubClassResponsibility signal. 12 | ] 13 | 14 | 15 | collect: aBlock [ 16 | SubClassResponsibility signal. 17 | ] 18 | 19 | 20 | inject: initialValue into: aBlock [ 21 | | result | 22 | 23 | result := initialValue. 24 | self do: [ :v | result := aBlock value: result value: v]. 25 | ^result 26 | ] 27 | 28 | 29 | detect: aBlock [ 30 | ^self detect: aBlock ifNone: [NotFoundError signal] 31 | ] 32 | 33 | 34 | detect: aBlock ifNone: aNoneBlock [ 35 | self do: [ :v | (aBlock value: v) ifTrue: [^v]]. 36 | ^aNoneBlock value 37 | ] 38 | 39 | 40 | anySatisfy: aBlock [ 41 | self do: [ :v | (aBlock value: v) ifTrue: [^true]]. 42 | ^false 43 | ] 44 | 45 | ] 46 | -------------------------------------------------------------------------------- /smalltalk/Magnitudes/Character.st: -------------------------------------------------------------------------------- 1 | Character := Magnitude [ 2 | 3 | | Table | 4 | 5 | 6 | "instance creation" 7 | 8 | class initialize [ 9 | Table := ByteArray new: 256 * 4. 10 | 11 | 0 to: 255 do: [ :i | 12 | (i between: 48 and: 57) "0-9" 13 | ifTrue: [ 14 | Table at: i + 1 put: i - 48. 15 | Table at: i + 257 put: 253 "digit"] 16 | ifFalse: [Table at: i + 1 put: 36]. 17 | (i between: 65 and: 90) "A-B" 18 | ifTrue: [ 19 | Table at: i + 1 put: i - 55. "digit value" 20 | Table at: i + 257 put: 254. "letter" 21 | Table at: i + 513 put: i + 32 "lower"] 22 | ifFalse: [ 23 | Table at: i + 513 put: i "lower"]. 24 | (i between: 97 and: 122) "a-b" 25 | ifTrue: [ 26 | Table at: i + 257 put: 254. "letter" 27 | Table at: i + 769 put: i - 32 "upper"] 28 | ifFalse: [ 29 | Table at: i + 769 put: i "upper"]. 30 | ]. 31 | 32 | Table 33 | at: $+ codePoint + 257 put: 252; 34 | at: $- codePoint + 257 put: 252; 35 | at: $/ codePoint + 257 put: 252; 36 | at: $\ codePoint + 257 put: 252; 37 | at: $* codePoint + 257 put: 252; 38 | at: $~ codePoint + 257 put: 252; 39 | at: $< codePoint + 257 put: 252; 40 | at: $> codePoint + 257 put: 252; 41 | at: $= codePoint + 257 put: 252; 42 | at: $@ codePoint + 257 put: 252; 43 | at: $% codePoint + 257 put: 252; 44 | at: $| codePoint + 257 put: 252; 45 | at: $& codePoint + 257 put: 252; 46 | at: $? codePoint + 257 put: 252; 47 | at: $! codePoint + 257 put: 252; 48 | "," 49 | 50 | at: $" codePoint + 257 put: 251; 51 | at: $# codePoint + 257 put: 251; 52 | at: $$ codePoint + 257 put: 251; 53 | at: $' codePoint + 257 put: 251; 54 | at: $( codePoint + 257 put: 251; 55 | at: $) codePoint + 257 put: 251; 56 | at: $; codePoint + 257 put: 251; 57 | at: $[ codePoint + 257 put: 251; 58 | at: $] codePoint + 257 put: 251; 59 | at: $^ codePoint + 257 put: 251; 60 | at: $_ codePoint + 257 put: 251; 61 | at: $` codePoint + 257 put: 251; 62 | at: ${ codePoint + 257 put: 251; 63 | at: $} codePoint + 257 put: 251; 64 | 65 | at: 9 + 257 put: 250; "tab" 66 | at: 10 + 257 put: 250; "lf" 67 | at: 12 + 257 put: 250; "ff" 68 | at: 13 + 257 put: 250; "cr" 69 | at: 32 + 257 put: 250; "space" 70 | 71 | at: $A codePoint + 257 put: 255; 72 | at: $E codePoint + 257 put: 255; 73 | at: $I codePoint + 257 put: 255; 74 | at: $O codePoint + 257 put: 255; 75 | at: $U codePoint + 257 put: 255; 76 | at: $a codePoint + 257 put: 255; 77 | at: $e codePoint + 257 put: 255; 78 | at: $i codePoint + 257 put: 255; 79 | at: $o codePoint + 257 put: 255; 80 | at: $u codePoint + 257 put: 255. 81 | ] 82 | 83 | 84 | class new [ 85 | ShouldNotImplement signal. 86 | ] 87 | 88 | 89 | class codePoint: anInteger [ 90 | 91 | Error signal. 92 | ] 93 | 94 | 95 | class digitValue: anInteger [ 96 | ^'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' at: anInteger + 1 97 | ] 98 | 99 | 100 | "untypeable characters " 101 | 102 | class cr [ 103 | ^self codePoint: 13 104 | ] 105 | 106 | 107 | class lf [ 108 | ^self codePoint: 10 109 | ] 110 | 111 | 112 | class space [ 113 | ^self codePoint: 32 114 | ] 115 | 116 | 117 | class tab [ 118 | ^self codePoint: 9 119 | ] 120 | 121 | 122 | "accessing" 123 | 124 | codePoint [ 125 | 126 | ] 127 | 128 | 129 | digitValue [ 130 | | digitValue | 131 | digitValue := Table at: self codePoint + 1. 132 | digitValue = 36 ifTrue: [self error: 'character is not digit']. 133 | ^digitValue 134 | ] 135 | 136 | 137 | "comparing" 138 | 139 | hash [ 140 | ^0 - self codePoint 141 | ] 142 | 143 | < aCharacter [ 144 | ^self codePoint < aCharacter codePoint 145 | ] 146 | 147 | 148 | "testing" 149 | 150 | isAlphaNumeric [ 151 | ^(Table at: self codePoint + 257) > 252 152 | ] 153 | 154 | 155 | isDigit [ 156 | ^self isDigit: 10 157 | ] 158 | 159 | 160 | isDigit: anInteger [ 161 | ^(Table at: self codePoint + 1) < anInteger 162 | ] 163 | 164 | 165 | isLetter [ 166 | ^(Table at: self codePoint + 257) > 253 167 | ] 168 | 169 | 170 | isSeparator [ 171 | ^(Table at: self codePoint + 257) = 250 172 | ] 173 | 174 | 175 | isSpecial [ 176 | ^(Table at: self codePoint + 257) = 252 177 | ] 178 | 179 | 180 | isLowercase [ 181 | ^self asLowercase = self 182 | ] 183 | 184 | 185 | isUppercase [ 186 | ^self asUppercase = self 187 | ] 188 | 189 | 190 | isVowel [ 191 | ^(Table at: self codePoint + 257) = 255 192 | ] 193 | 194 | 195 | "converting" 196 | 197 | asLowercase [ 198 | ^self class codePoint: (Table at: self codePoint + 513) 199 | ] 200 | 201 | 202 | asUppercase [ 203 | ^self class codePoint: (Table at: self codePoint + 769) 204 | ] 205 | 206 | 207 | "printing" 208 | 209 | printOn: aStream [ 210 | aStream nextPut: $$. 211 | (Table at: self codePoint + 257) > 250 212 | ifTrue: [aStream nextPut: self] 213 | ifFalse: [ 214 | self = self class space ifTrue: [ 215 | aStream nextPutAll: ''. 216 | ^self]. 217 | self = self class lf ifTrue: [ 218 | aStream nextPutAll: ''. 219 | ^self]. 220 | self = self class cr ifTrue: [ 221 | aStream nextPutAll: ''. 222 | ^self]. 223 | aStream nextPut: $<. 224 | self codePoint printOn: aStream. 225 | aStream nextPut: $>]. 226 | ] 227 | 228 | ] 229 | -------------------------------------------------------------------------------- /smalltalk/Magnitudes/DateTime.st: -------------------------------------------------------------------------------- 1 | DateTime := Magnitude [ 2 | 3 | | milliSeconds MillisecondsPerDay DaysIn4Years DaysIn100Years DaysIn400Years 4 | Days1970To2000 DaysOffset YearsOffset | 5 | 6 | class now [ 7 | ^self new initializeMilliSeconds: self currentMicroTime // 1000 8 | ] 9 | 10 | 11 | class initialize [ 12 | MillisecondsPerDay := 24 * 60 * 60 * 1000. 13 | DaysIn4Years := 4 * 365 + 1. 14 | DaysIn100Years := 25 * DaysIn4Years - 1. 15 | DaysIn400Years := 4 * DaysIn100Years + 1. 16 | Days1970To2000 := 30 * 365 + 7. 17 | DaysOffset := (1000 * DaysIn400Years) + (5 * DaysIn400Years) - Days1970To2000. 18 | YearsOffset := 400000. 19 | ] 20 | 21 | 22 | class currentMicroTime [ 23 | 24 | ] 25 | 26 | 27 | initializeMilliSeconds: anInteger [ 28 | milliSeconds := anInteger. 29 | ] 30 | 31 | 32 | "accessing" 33 | 34 | second [ 35 | ^milliSeconds // 1000 \\ 60 36 | ] 37 | 38 | 39 | minute [ 40 | ^milliSeconds // (1000 * 60) \\ 60 41 | ] 42 | 43 | 44 | hour [ 45 | ^milliSeconds // (1000 * 60 * 60) \\ 24 46 | ] 47 | 48 | 49 | day [ 50 | ^self computeDate at: 3 51 | ] 52 | 53 | 54 | month [ 55 | ^self computeDate at: 2 56 | ] 57 | 58 | 59 | year [ 60 | ^self computeDate at: 1 61 | ] 62 | 63 | 64 | computeDate [ 65 | | resultYear resultMonth days yd1 yd2 yd3 isLeap daysUntilMonth result | 66 | 67 | resultYear := 0. 68 | resultMonth := 0. 69 | 70 | days := milliSeconds // MillisecondsPerDay + DaysOffset. 71 | 72 | resultYear := 400 * (days // DaysIn400Years) - YearsOffset. 73 | 74 | days := days \\ DaysIn400Years - 1. 75 | yd1 := days // DaysIn100Years. 76 | days := days \\ DaysIn100Years. 77 | 78 | resultYear := resultYear + (100 * yd1). 79 | 80 | days := days + 1. 81 | yd2 := days // DaysIn4Years. 82 | days := days \\ DaysIn4Years. 83 | resultYear := resultYear + (4 * yd2). 84 | 85 | days := days - 1. 86 | yd3 := days // 365. 87 | days := days \\ 365. 88 | resultYear := resultYear + yd3. 89 | 90 | isLeap := (yd1 = 0 or: [yd2 ~= 0]) and: [yd3 = 0]. 91 | isLeap ifTrue: [days := days + 1]. 92 | 93 | daysUntilMonth := isLeap 94 | ifTrue: [#(0 31 60 91 121 152 182 213 244 274 305 335)] 95 | ifFalse: [#(0 31 59 90 120 151 181 212 243 273 304 334)]. 96 | resultMonth := 12. 97 | [(daysUntilMonth at: resultMonth) > days] whileTrue: [resultMonth := resultMonth - 1]. 98 | 99 | result := Array new: 3. 100 | result at: 1 put: resultYear. 101 | result at: 2 put: resultMonth. 102 | result at: 3 put: days - (daysUntilMonth at: resultMonth) + 1. 103 | ^result 104 | ] 105 | 106 | 107 | "printing" 108 | 109 | printOn: aStream [ 110 | | date year month day | 111 | 112 | date := self computeDate. 113 | year := date at: 1. 114 | month := date at: 2. 115 | day := date at: 3. 116 | 117 | year printOn: aStream. 118 | aStream nextPut: $-. 119 | month < 10 ifTrue: [aStream nextPut: $0]. 120 | month printOn: aStream. 121 | aStream nextPut: $-. 122 | day < 10 ifTrue: [aStream nextPut: $0]. 123 | day printOn: aStream. 124 | aStream space. 125 | 126 | self hour < 10 ifTrue: [aStream nextPut: $0]. 127 | self hour printOn: aStream. 128 | aStream nextPut: $:. 129 | self minute < 10 ifTrue: [aStream nextPut: $0]. 130 | self minute printOn: aStream. 131 | aStream nextPut: $:. 132 | self second < 10 ifTrue: [aStream nextPut: $0]. 133 | self second printOn: aStream. 134 | ] 135 | 136 | ] 137 | -------------------------------------------------------------------------------- /smalltalk/Magnitudes/Integer.st: -------------------------------------------------------------------------------- 1 | Integer := Number [ 2 | 3 | "arithmetic" 4 | 5 | // aNumber [ 6 | ^(self - (self < 0 ifTrue: [aNumber - 1] ifFalse: [0])) quo: aNumber 7 | ] 8 | 9 | 10 | "mathematical functions" 11 | 12 | floorLog: radix [ 13 | | me result | 14 | 15 | self < 0 ifTrue: ["Arithmetic"Error signal: 'cannot extract logarithm of a negative number']. 16 | radix <= radix unity ifTrue: [ 17 | radix <= radix zero ifTrue: ["Arithmetic"Error signal: 'base of a logarithm cannot be negative']. 18 | radix = radix unity ifTrue: ["Arithmetic"Error signal: 'base of a logarithm cannot be 1']. 19 | ^(self ceilingLog: radix reciprocal) negated 20 | ]. 21 | 22 | "radix isInteger ifFalse: [^(radix coerce: self) floorLog: radix]." 23 | me := self. 24 | result := 0. 25 | [me >= radix] whileTrue: [ 26 | me := me // radix. 27 | result := result + 1. 28 | ]. 29 | 30 | ^result 31 | ] 32 | 33 | 34 | "iterators" 35 | 36 | timesRepeat: aBlock [ 37 | 1 to: self do: [ :each | aBlock value]. 38 | ] 39 | 40 | ] 41 | -------------------------------------------------------------------------------- /smalltalk/Magnitudes/Magnitude.st: -------------------------------------------------------------------------------- 1 | Magnitude := Object [ 2 | 3 | "comparing" 4 | 5 | < aMagnitude [ 6 | SubClassResponsibility signal. 7 | ] 8 | 9 | 10 | > aMagnitude [ 11 | ^aMagnitude < self 12 | ] 13 | 14 | 15 | >= aMagnitude [ 16 | ^(self < aMagnitude) not 17 | ] 18 | 19 | 20 | <= aMagnitude [ 21 | ^(aMagnitude < self) not 22 | ] 23 | 24 | 25 | between: min and: max [ 26 | ^self >= min and: [self <= max] 27 | ] 28 | 29 | 30 | "testing" 31 | 32 | max: aMagnitude [ 33 | ^aMagnitude <= self ifTrue: [self] ifFalse: [aMagnitude] 34 | ] 35 | 36 | 37 | min: aMagnitude [ 38 | ^aMagnitude > self ifTrue: [self] ifFalse: [aMagnitude] 39 | ] 40 | 41 | ] 42 | -------------------------------------------------------------------------------- /smalltalk/Magnitudes/Number.st: -------------------------------------------------------------------------------- 1 | Number := Magnitude [ 2 | 3 | "instance creation" 4 | 5 | class readFrom: aStream base: anInteger [ 6 | | char sign int exp isFloat | 7 | 8 | isFloat := false. 9 | sign := 1. 10 | int := 0. 11 | 12 | char := aStream peek. 13 | char isNil ifTrue: [^0]. 14 | char = $- ifTrue: [ 15 | sign := -1. 16 | aStream next]. 17 | 18 | char := aStream peek. 19 | char isNil ifTrue: [^0]. 20 | char := char asUppercase. 21 | ((char isDigit: anInteger) or: [char = $.]) ifFalse: [^0]. 22 | 23 | [char notNil and: [(char := char asUppercase) isDigit: anInteger]] whileTrue: [ 24 | aStream next. 25 | int := sign * char digitValue + (int * anInteger). 26 | char := aStream peek. 27 | ]. 28 | char isNil ifTrue: [^int]. 29 | 30 | char = $. ifTrue: [ 31 | aStream next. 32 | isFloat := true. 33 | [(char := aStream peek) notNil and: [(char := char asUppercase) isDigit: anInteger]] whileTrue: [ 34 | sign := sign / anInteger. 35 | int := sign * char digitValue + int. 36 | aStream next. 37 | ]. 38 | ]. 39 | 40 | exp := 0. 41 | (anInteger = 10 and: [char = $E]) ifFalse: [ 42 | ^isFloat ifTrue: [int asFloat] ifFalse: [int] 43 | ]. 44 | 45 | aStream next. 46 | char := aStream peek. 47 | char isNil ifTrue: [^int]. 48 | sign := 1. 49 | char = $+ ifTrue: [sign := 1. aStream next]. 50 | char = $- ifTrue: [sign := -1. aStream next]. 51 | 52 | [(char := aStream peek) notNil and: [char isDigit]] whileTrue: [ 53 | exp := char digitValue + (exp * 10). 54 | aStream next. 55 | ]. 56 | 57 | int := int * (10 raisedToInteger: exp * sign). 58 | ^int asFloat 59 | ] 60 | 61 | 62 | class readFrom: aStream [ 63 | ^self readFrom: aStream base: 10 64 | ] 65 | 66 | 67 | "arithmetic" 68 | 69 | + aNumber [ 70 | SubClassResponsibility signal. 71 | ] 72 | 73 | 74 | - aNumber [ 75 | SubClassResponsibility signal. 76 | ] 77 | 78 | 79 | * aNumber [ 80 | SubClassResponsibility signal. 81 | ] 82 | 83 | 84 | / aNumber [ 85 | SubClassResponsibility signal. 86 | ] 87 | 88 | 89 | // aNumber [ 90 | "Answer the integer quotient defined by division with truncation toward negative infinity." 91 | SubClassResponsibility signal. 92 | ] 93 | 94 | 95 | \\ aNumber [ 96 | "Answer the integer remainder defined by division with truncation toward negative infinity. 97 | This is the modulo operation." 98 | SubClassResponsibility signal. 99 | ] 100 | 101 | 102 | abs [ 103 | self < 0 ifTrue: [^self negated]. 104 | ^self 105 | ] 106 | 107 | 108 | negated [ 109 | ^0 - self 110 | ] 111 | 112 | 113 | quo: aNumber [ 114 | "Answer the integer quotient defined by division with truncation toward zero." 115 | SubClassResponsibility signal. 116 | ] 117 | 118 | rem: aNumber [ 119 | "Answer the integer remainder defined by division with truncation toward zero." 120 | SubClassResponsibility signal. 121 | ] 122 | 123 | 124 | "mathematical functions" 125 | 126 | exp [ 127 | 128 | ] 129 | 130 | 131 | ln [ 132 | 133 | ] 134 | 135 | 136 | log: aNumber [ 137 | 138 | ] 139 | 140 | 141 | floorLog: aNumber [ 142 | 143 | ] 144 | 145 | 146 | raisedTo: aNumber [ 147 | 148 | ] 149 | 150 | 151 | raisedToInteger: anInteger [ 152 | 153 | ] 154 | 155 | 156 | sqrt [ 157 | 158 | ] 159 | 160 | 161 | squared [ 162 | ^self * self 163 | ] 164 | 165 | 166 | "testing" 167 | 168 | even [ 169 | 170 | ] 171 | 172 | 173 | odd [ 174 | 175 | ] 176 | 177 | 178 | negative [ 179 | ^self < 0 180 | ] 181 | 182 | 183 | positive [ 184 | ^self >= 0 185 | ] 186 | 187 | 188 | strictlyPositive [ 189 | ^self > 0 190 | ] 191 | 192 | 193 | sign [ 194 | self < 0 ifTrue: [^-1]. 195 | self > 0 ifTrue: [^1]. 196 | ^0 197 | ] 198 | 199 | 200 | "truncation and round off" 201 | 202 | ceiling [ 203 | 204 | ] 205 | 206 | 207 | floor [ 208 | 209 | ] 210 | 211 | 212 | truncated [ 213 | 214 | ] 215 | 216 | 217 | truncateTo: aNumber [ 218 | 219 | ] 220 | 221 | 222 | rounded [ 223 | 224 | ] 225 | 226 | 227 | roundTo: aNumber [ 228 | 229 | ] 230 | 231 | 232 | "converting" 233 | 234 | degreesToRadians [ 235 | 236 | ] 237 | 238 | 239 | radiansToDegrees [ 240 | 241 | ] 242 | 243 | 244 | "intervals" 245 | 246 | to: stop [ 247 | ^Interval from: self to: stop 248 | ] 249 | 250 | 251 | to: stop by: step [ 252 | ^Interval from: self to: stop by: step 253 | ] 254 | 255 | 256 | to: stop by: step do: aBlock [ 257 | | i | 258 | 259 | i := self. 260 | step > step zero 261 | ifTrue: [ 262 | [i <= stop] whileTrue: [ 263 | aBlock value: i. 264 | i := i + step]] 265 | ifFalse: [ 266 | [i >= stop] whileTrue: [ 267 | aBlock value: i. 268 | i := i + step]]. 269 | ] 270 | 271 | 272 | to: stop do: aBlock [ 273 | | i | 274 | 275 | i := self. 276 | [i <= stop] whileTrue: [ 277 | aBlock value: i. 278 | i := i + self unity]. 279 | ] 280 | 281 | ] 282 | -------------------------------------------------------------------------------- /smalltalk/Magnitudes/SmallInteger.st: -------------------------------------------------------------------------------- 1 | SmallInteger := Integer [ 2 | 3 | "comparing" 4 | 5 | hash [ 6 | ^self 7 | ] 8 | 9 | 10 | identityHash [ 11 | ^self 12 | ] 13 | 14 | 15 | < aNumber [ 16 | 17 | ^self primitiveFailedFor: aNumber. 18 | ] 19 | 20 | 21 | "arithmetic" 22 | 23 | + aNumber [ 24 | 25 | ^self primitiveFailedFor: aNumber. 26 | ] 27 | 28 | 29 | - aNumber [ 30 | 31 | ^self primitiveFailedFor: aNumber. 32 | ] 33 | 34 | 35 | * aNumber [ 36 | 37 | ^self primitiveFailedFor: aNumber. 38 | ] 39 | 40 | 41 | / aNumber [ 42 | "IntDiv" 43 | 44 | ^self primitiveFailedFor: aNumber. 45 | ] 46 | 47 | 48 | "// aNumber [ 49 | 50 | ]" 51 | 52 | 53 | \\ aNumber [ 54 | 55 | ^self primitiveFailedFor: aNumber. 56 | ] 57 | 58 | 59 | quo: aNumber [ 60 | 61 | ^self primitiveFailedFor: aNumber. 62 | ] 63 | 64 | 65 | rem: aNumber [ 66 | 67 | ^self primitiveFailedFor: aNumber. 68 | ] 69 | 70 | 71 | negated [ 72 | 73 | ^self primitiveFailedFor: self. 74 | ] 75 | 76 | 77 | "bit manipulation" 78 | 79 | bitAnd: anInteger [ 80 | 81 | ^self primitiveFailedFor: anInteger. 82 | ] 83 | 84 | 85 | bitOr: anInteger [ 86 | 87 | ^self primitiveFailedFor: anInteger. 88 | ] 89 | 90 | 91 | bitXor: anInteger [ 92 | 93 | ^self primitiveFailedFor: anInteger. 94 | ] 95 | 96 | 97 | bitShift: anInteger [ 98 | 99 | ^self primitiveFailedFor: anInteger. 100 | ] 101 | 102 | 103 | bitInvert [ 104 | ^self bitXor: -1 105 | ] 106 | 107 | 108 | highBit [ 109 | | n bit | 110 | 111 | self = 0 ifTrue: [^0]. 112 | 113 | bit := 0. 114 | self < 0 115 | ifTrue: [ 116 | "Increment the result by one if not a power of two" 117 | n := self negated. 118 | (n bitAnd: self) = n ifFalse: [bit := 1]] 119 | ifFalse: [ 120 | n := self. 121 | bit := 0]. 122 | 123 | [n > 16r1FFFFFFFFFFFFFFF] whileTrue: [ 124 | bit := bit + 62. 125 | n := n bitShift: -62]. 126 | 127 | n > 16rFFFFFFFF ifTrue: [ 128 | bit := bit + 32. 129 | n := n bitShift: -32]. 130 | 131 | n > 16rFFFF ifTrue: [ 132 | bit := bit + 16. 133 | n := n bitShift: -16]. 134 | 135 | n > 16rFF ifTrue: [ 136 | bit := bit + 8. 137 | n := n bitShift: -8]. 138 | 139 | n > 16rF ifTrue: [ 140 | bit := bit + 4. 141 | n := n bitShift: -4]. 142 | 143 | n > 3 ifTrue: [ 144 | bit := bit + 2. 145 | n := n bitShift: -2]. 146 | 147 | n > 1 ifTrue: [ 148 | bit := bit + 1. 149 | n := n bitShift: -1]. 150 | 151 | ^n + bit 152 | ] 153 | 154 | 155 | "private" 156 | 157 | zero [ 158 | ^0 159 | ] 160 | 161 | 162 | unity [ 163 | ^1 164 | ] 165 | 166 | 167 | asObject [ 168 | 169 | ] 170 | 171 | 172 | primitiveFailedFor: aNumber [ 173 | (aNumber isKindOf: Number) ifFalse: [Error signal: aNumber asString, ' is not a Number']. 174 | Error signal: 'Integer overflow'. "TODO: add support for large integer" 175 | ] 176 | 177 | 178 | "copying" 179 | 180 | shallowCopy [ 181 | ^self 182 | ] 183 | 184 | 185 | deepCopy [ 186 | ^self 187 | ] 188 | 189 | 190 | "testing" 191 | 192 | even [ 193 | ^(self bitAnd: 1) = 0 194 | ] 195 | 196 | 197 | odd [ 198 | ^(self bitAnd: 1) = 1 199 | ] 200 | 201 | 202 | "printing" 203 | 204 | printOn: aStream [ 205 | self printOn: aStream base: 10. 206 | ] 207 | 208 | 209 | printOn: aStream base: base [ 210 | aStream nextPutAll: (self printStringBase: base). 211 | ] 212 | 213 | 214 | printString [ 215 | ^self printStringBase: 10 216 | ] 217 | 218 | 219 | printStringBase: base [ 220 | | int string i | 221 | 222 | self < 0 223 | ifTrue: [ 224 | int := self negated. 225 | i := (int floorLog: base) + 2. 226 | string := String new: i. 227 | string at: 1 put: $-] 228 | ifFalse: [ 229 | int := self. 230 | i := (int floorLog: base) + 1. 231 | string := String new: i]. 232 | 233 | [string at: i put: (Character digitValue: int \\ base). 234 | i := i - 1. 235 | (int := int // base) > 0] 236 | whileTrue. 237 | 238 | ^string 239 | ] 240 | 241 | ] 242 | -------------------------------------------------------------------------------- /smalltalk/Message.st: -------------------------------------------------------------------------------- 1 | Message := Object [ 2 | 3 | | selector arguments | 4 | 5 | 6 | "accessing" 7 | 8 | selector [ 9 | ^selector 10 | ] 11 | 12 | 13 | arguments [ 14 | ^arguments 15 | ] 16 | 17 | ] 18 | -------------------------------------------------------------------------------- /smalltalk/MessageNotUnderstood.st: -------------------------------------------------------------------------------- 1 | MessageNotUnderstood := Error [ 2 | 3 | | receiver message | 4 | 5 | 6 | "accessing" 7 | 8 | receiver: anObject [ 9 | receiver := anObject. 10 | ] 11 | 12 | 13 | receiver [ 14 | ^receiver 15 | ] 16 | 17 | 18 | message: aMessage [ 19 | message := aMessage. 20 | ] 21 | 22 | 23 | message [ 24 | ^message 25 | ] 26 | 27 | 28 | defaultMessageText [ 29 | ^receiver printString, ' did not understand ', message selector printString 30 | ] 31 | 32 | ] 33 | -------------------------------------------------------------------------------- /smalltalk/MetaClass.st: -------------------------------------------------------------------------------- 1 | MetaClass := ClassDescription [ 2 | 3 | | instanceClass | 4 | 5 | 6 | "accessing" 7 | 8 | instanceClass [ 9 | ^instanceClass 10 | ] 11 | 12 | 13 | name [ 14 | ^instanceClass name 15 | ] 16 | 17 | 18 | "printing" 19 | 20 | printOn: aStream [ 21 | instanceClass printOn: aStream. 22 | aStream nextPutAll: ' class'. 23 | ] 24 | 25 | ] 26 | -------------------------------------------------------------------------------- /smalltalk/MethodContext.st: -------------------------------------------------------------------------------- 1 | MethodContext := Context [ 2 | 3 | "accessing" 4 | 5 | method [ 6 | ^self code 7 | ] 8 | 9 | 10 | "error handling" 11 | 12 | cannotReturn: anObject [ 13 | Error signal: 'return from death context'. 14 | ] 15 | 16 | ] 17 | 18 | -------------------------------------------------------------------------------- /smalltalk/NotFoundError.st: -------------------------------------------------------------------------------- 1 | NotFoundError := Exception [ 2 | 3 | | value | 4 | 5 | 6 | "instance creation" 7 | 8 | class value: anObject [ 9 | ^self new value: anObject 10 | ] 11 | 12 | 13 | "accessing" 14 | 15 | value: anObject [ 16 | value := anObject. 17 | ] 18 | 19 | 20 | value [ 21 | ^value 22 | ] 23 | 24 | 25 | defaultMessageText [ 26 | ^value printString, ' not found' 27 | ] 28 | 29 | ] 30 | -------------------------------------------------------------------------------- /smalltalk/Object.st: -------------------------------------------------------------------------------- 1 | Object := nil [ 2 | 3 | "accessing" 4 | 5 | at: anInteger [ 6 | 7 | (OutOfRangeError value: anInteger between: 1 and: self basicSize) signal. 8 | ] 9 | 10 | 11 | at: anInteger put: anObject [ 12 | 13 | (OutOfRangeError value: anInteger between: 1 and: self basicSize) signal. 14 | ] 15 | 16 | 17 | basicAt: anInteger [ 18 | 19 | (OutOfRangeError value: anInteger between: 1 and: self basicSize) signal. 20 | ] 21 | 22 | 23 | basicAt: anInteger put: anObject [ 24 | 25 | (OutOfRangeError value: anInteger between: 1 and: self basicSize) signal. 26 | ] 27 | 28 | 29 | size [ 30 | 31 | ] 32 | 33 | 34 | basicSize [ 35 | 36 | ] 37 | 38 | 39 | yourself [ 40 | ^self 41 | ] 42 | 43 | 44 | "system primitives" 45 | 46 | instVarAt: anInteger [ 47 | 48 | (OutOfRangeError value: anInteger between: 1 and: self class instanceSize) signal. 49 | ] 50 | 51 | 52 | instVarAt: anInteger put: anObject [ 53 | 54 | (OutOfRangeError value: anInteger between: 1 and: self class instanceSize) signal. 55 | ] 56 | 57 | 58 | become: otherObject [ 59 | 60 | ] 61 | 62 | 63 | "comparing" 64 | 65 | = anObject [ 66 | 67 | ] 68 | 69 | 70 | == anObject [ 71 | 72 | ] 73 | 74 | 75 | hash [ 76 | 77 | ] 78 | 79 | 80 | ~= anObject [ 81 | ^self = anObject == false 82 | ] 83 | 84 | 85 | ~~ anObject [ 86 | ^self == anObject == false 87 | ] 88 | 89 | 90 | identityHash [ 91 | 92 | ] 93 | 94 | 95 | "private" 96 | 97 | species [ 98 | ^self class 99 | ] 100 | 101 | 102 | "class membership" 103 | 104 | class [ 105 | 106 | ] 107 | 108 | 109 | isKindOf: aClass [ 110 | ^self class == aClass 111 | ifTrue: [true] 112 | ifFalse: [self class inheritsFrom: aClass] 113 | ] 114 | 115 | 116 | isMemberOf: aClass [ 117 | ^self class == aClass 118 | ] 119 | 120 | 121 | respondsTo: aSymbol [ 122 | ^self class canUnderstand: aSymbol 123 | ] 124 | 125 | 126 | "testing" 127 | 128 | isNil [ 129 | ^false 130 | ] 131 | 132 | 133 | notNil [ 134 | ^self isNil not 135 | ] 136 | 137 | 138 | "copying" 139 | 140 | copy [ 141 | ^self shallowCopy 142 | ] 143 | 144 | 145 | shallowCopy [ 146 | | copy class index | 147 | 148 | class := self class. 149 | 150 | class isIndexable 151 | ifTrue: [ 152 | index := self basicSize. 153 | copy := class basicNew: index. 154 | [index > 0] whileTrue: [ 155 | copy basicAt: index put: (self basicAt: index). 156 | index := index - 1]] 157 | ifFalse: [ 158 | copy := class basicNew]. 159 | 160 | index := class instanceSize. 161 | [index > 0] whileTrue: [ 162 | copy instVarAt: index put: (self instVarAt: index). 163 | index := index - 1]. 164 | 165 | ^copy 166 | ] 167 | 168 | 169 | deepCopy [ 170 | | copy class index | 171 | 172 | class := self class. 173 | 174 | class isIndexable 175 | ifTrue: [ 176 | index := self basicSize. 177 | copy := class basicNew: index. 178 | [index > 0] whileTrue: [ 179 | copy basicAt: index put: (self basicAt: index) copy. 180 | index := index - 1]] 181 | ifFalse: [ 182 | copy := class basicNew]. 183 | 184 | index := class instanceSize. 185 | [index > 0] whileTrue: [ 186 | copy instVarAt: index put: (self instVarAt: index) copy. 187 | index := index - 1]. 188 | 189 | ^copy 190 | ] 191 | 192 | 193 | "error handling" 194 | 195 | doesNotUnderstand: aMessage [ 196 | MessageNotUnderstood new 197 | receiver: self; 198 | message: aMessage; 199 | signal. 200 | ] 201 | 202 | 203 | "associating" 204 | 205 | -> value [ 206 | ^Association key: self value: value 207 | ] 208 | 209 | 210 | "printing" 211 | 212 | printString [ 213 | | stream | 214 | 215 | stream := CollectionStream with: (String new: 128). 216 | self printOn: stream. 217 | ^stream contents 218 | ] 219 | 220 | 221 | printNl [ 222 | self printOn: Transcript. 223 | Transcript lf. 224 | ] 225 | 226 | 227 | print [ 228 | self printOn: Transcript. 229 | ] 230 | 231 | 232 | printOn: aStream [ 233 | self basicPrintOn: aStream. 234 | ] 235 | 236 | 237 | basicPrintOn: aStream [ 238 | | name | 239 | 240 | name := self class name. 241 | aStream 242 | nextPutAll: (name first isVowel ifTrue: ['an '] ifFalse: ['a ']); 243 | nextPutAll: name. 244 | ] 245 | 246 | 247 | inspect [ 248 | self examineOn: Transcript. 249 | ] 250 | 251 | 252 | examineOn: aStream [ 253 | | instVars | 254 | 255 | instVars := self class instanceVariables. 256 | 257 | self basicPrintOn: aStream. 258 | aStream lf. 259 | 260 | 1 to: instVars size do: [ :i | 261 | aStream 262 | space; 263 | nextPutAll: (instVars at: i); 264 | nextPutAll: ': '. 265 | (self instVarAt: i) == self 266 | ifTrue: [aStream nextPutAll: 'self (recursion)'] 267 | ifFalse: [(self instVarAt: i) basicPrintOn: aStream]. 268 | aStream lf]. 269 | 270 | 1 to: self basicSize do: [ :i | 271 | aStream nextPutAll: ' - '. 272 | (self basicAt: i) == self 273 | ifTrue: [aStream nextPutAll: 'self (recursion)'] 274 | ifFalse: [(self basicAt: i) basicPrintOn: aStream]. 275 | aStream lf]. 276 | ] 277 | 278 | ] 279 | -------------------------------------------------------------------------------- /smalltalk/OutOfRangeError.st: -------------------------------------------------------------------------------- 1 | OutOfRangeError := Error [ 2 | 3 | | value min max | 4 | 5 | 6 | "instance creation" 7 | 8 | class value: value between: min and: max [ 9 | ^self new initializeValue: value min: min max: max 10 | ] 11 | 12 | 13 | "initialization" 14 | 15 | initializeValue: aValue min: aMin max: aMax [ 16 | value := aValue. 17 | min := aMin. 18 | max := aMax. 19 | ] 20 | 21 | 22 | "accessing" 23 | 24 | value [ 25 | ^value 26 | ] 27 | 28 | 29 | min [ 30 | ^min 31 | ] 32 | 33 | 34 | max [ 35 | ^max 36 | ] 37 | 38 | 39 | defaultMessageText [ 40 | ^value printString, ' is out of allowed range (', 41 | min printString, ' to ', max printString, ')' 42 | ] 43 | 44 | ] 45 | -------------------------------------------------------------------------------- /smalltalk/Parser/ArrayNode.st: -------------------------------------------------------------------------------- 1 | ArrayNode := LiteralNode [ 2 | 3 | acceptVisitor: aVisitor [ 4 | aVisitor visitArrayNode: self. 5 | self value do: [ :v | v acceptVisitor: aVisitor]. 6 | ] 7 | 8 | ] 9 | -------------------------------------------------------------------------------- /smalltalk/Parser/BlockNode.st: -------------------------------------------------------------------------------- 1 | BlockNode := Object [ 2 | 3 | | arguments temporaries expressions scope sourceCode | 4 | 5 | 6 | arguments [ 7 | ^arguments 8 | ] 9 | 10 | 11 | temporaries [ 12 | ^temporaries 13 | ] 14 | 15 | 16 | expressions [ 17 | ^expressions 18 | ] 19 | 20 | 21 | scope [ 22 | ^scope 23 | ] 24 | 25 | 26 | sourceCode [ 27 | ^sourceCode 28 | ] 29 | 30 | 31 | acceptVisitor: aVisitor [ 32 | aVisitor visitBlockNode: self. 33 | arguments do: [ :arg | arg acceptVisitor: aVisitor]. 34 | temporaries do: [ :tmp | tmp acceptVisitor: aVisitor]. 35 | expressions do: [ :expr | expr acceptVisitor: aVisitor]. 36 | ] 37 | 38 | ] 39 | -------------------------------------------------------------------------------- /smalltalk/Parser/BlockScope.st: -------------------------------------------------------------------------------- 1 | BlockScope := Object [ 2 | 3 | | header parent vars ownerClass literals error | 4 | 5 | ] 6 | -------------------------------------------------------------------------------- /smalltalk/Parser/CharacterNode.st: -------------------------------------------------------------------------------- 1 | CharacterNode := LiteralNode [ 2 | 3 | acceptVisitor: aVisitor [ 4 | aVisitor visitCharacterNode: self. 5 | ] 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /smalltalk/Parser/ClassNode.st: -------------------------------------------------------------------------------- 1 | ClassNode := Object [ 2 | 3 | | name superName pragmas variables methods sourceCode | 4 | 5 | 6 | name [ 7 | ^name 8 | ] 9 | 10 | 11 | superName [ 12 | ^superName 13 | ] 14 | 15 | 16 | variables [ 17 | ^variables 18 | ] 19 | 20 | 21 | methods [ 22 | ^methods 23 | ] 24 | 25 | 26 | sourceCode [ 27 | ^sourceCode 28 | ] 29 | 30 | 31 | acceptVisitor: aVisitor [ 32 | aVisitor visitClassNode: self. 33 | name acceptVisitor: aVisitor. 34 | superName acceptVisitor: aVisitor. 35 | pragmas do: [ :pragma | pragma acceptVisitor: aVisitor]. 36 | variables do: [ :var | var acceptVisitor: aVisitor]. 37 | methods do: [ :method | method acceptVisitor: aVisitor]. 38 | ] 39 | 40 | ] 41 | -------------------------------------------------------------------------------- /smalltalk/Parser/ExpressionNode.st: -------------------------------------------------------------------------------- 1 | ExpressionNode := Object [ 2 | 3 | | returns assigments receiver messageExpressions sourceCode | 4 | 5 | 6 | returns [ 7 | ^returns 8 | ] 9 | 10 | 11 | enableReturn [ 12 | returns := true. 13 | ] 14 | 15 | 16 | disableReturn [ 17 | returns := false. 18 | ] 19 | 20 | 21 | assigments [ 22 | ^assigments 23 | ] 24 | 25 | 26 | receiver [ 27 | ^receiver 28 | ] 29 | 30 | 31 | messageExpressions [ 32 | ^messageExpressions 33 | ] 34 | 35 | 36 | sourceCode [ 37 | ^sourceCode 38 | ] 39 | 40 | 41 | acceptVisitor: aVisitor [ 42 | aVisitor visitExpressionNode: self. 43 | assigments do: [ :assigment | assigment acceptVisitor: aVisitor]. 44 | receiver acceptVisitor: aVisitor. 45 | messageExpressions do: [ :exp | exp acceptVisitor: aVisitor]. 46 | ] 47 | 48 | ] 49 | -------------------------------------------------------------------------------- /smalltalk/Parser/FalseNode.st: -------------------------------------------------------------------------------- 1 | FalseNode := LiteralNode [ 2 | 3 | acceptVisitor: aVisitor [ 4 | aVisitor visitFalseNode: self. 5 | ] 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /smalltalk/Parser/IntegerNode.st: -------------------------------------------------------------------------------- 1 | IntegerNode := LiteralNode [ 2 | 3 | acceptVisitor: aVisitor [ 4 | aVisitor visitIntegerNode: self. 5 | ] 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /smalltalk/Parser/LiteralNode.st: -------------------------------------------------------------------------------- 1 | LiteralNode := Object [ 2 | 3 | | value sourceCode | 4 | 5 | 6 | class value: anObject [ 7 | ^self new initializeValue: anObject 8 | ] 9 | 10 | 11 | initializeValue: anObject [ 12 | value := anObject. 13 | ] 14 | 15 | 16 | value [ 17 | ^value 18 | ] 19 | 20 | 21 | sourceCode [ 22 | ^sourceCode 23 | ] 24 | 25 | ] 26 | -------------------------------------------------------------------------------- /smalltalk/Parser/MessageExpressionNode.st: -------------------------------------------------------------------------------- 1 | MessageExpressionNode := Object [ 2 | 3 | | selector arguments sourceCode | 4 | 5 | 6 | selector [ 7 | ^selector 8 | ] 9 | 10 | 11 | arguments [ 12 | ^arguments 13 | ] 14 | 15 | 16 | sourceCode [ 17 | ^sourceCode 18 | ] 19 | 20 | 21 | acceptVisitor: aVisitor [ 22 | aVisitor visitMessageExpressionNode: self. 23 | arguments do: [ :arg | arg acceptVisitor: aVisitor]. 24 | ] 25 | 26 | ] 27 | -------------------------------------------------------------------------------- /smalltalk/Parser/MethodNode.st: -------------------------------------------------------------------------------- 1 | MethodNode := Object [ 2 | 3 | | className selector pragmas body sourceCode | 4 | 5 | 6 | className [ 7 | ^className 8 | ] 9 | 10 | 11 | selector [ 12 | ^selector 13 | ] 14 | 15 | 16 | pragmas [ 17 | ^pragmas 18 | ] 19 | 20 | 21 | body [ 22 | ^body 23 | ] 24 | 25 | 26 | arguments [ 27 | ^body arguments 28 | ] 29 | 30 | 31 | temporaries [ 32 | ^body temporaries 33 | ] 34 | 35 | 36 | expressions [ 37 | ^body expressions 38 | ] 39 | 40 | 41 | sourceCode [ 42 | ^sourceCode 43 | ] 44 | 45 | 46 | acceptVisitor: aVisitor [ 47 | aVisitor visitMethodNode: self. 48 | pragmas do: [ :pragma | pragma acceptVisitor: aVisitor]. 49 | body acceptVisitor: aVisitor. 50 | ] 51 | 52 | ] 53 | -------------------------------------------------------------------------------- /smalltalk/Parser/NilNode.st: -------------------------------------------------------------------------------- 1 | NilNode := LiteralNode [ 2 | 3 | acceptVisitor: aVisitor [ 4 | aVisitor visitNilNode: self. 5 | ] 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /smalltalk/Parser/ParseError.st: -------------------------------------------------------------------------------- 1 | ParseError := Error [ 2 | 3 | | token sourceCode | 4 | 5 | 6 | defaultMessageText [ 7 | ^'Parse error: unexpected ', 8 | (token isEmpty ifTrue: ['end of input'] ifFalse: [token]), 9 | ' in ''', sourceCode source, 10 | ''' line ', sourceCode line printString, 11 | ' column ', sourceCode column printString 12 | ] 13 | 14 | ] 15 | -------------------------------------------------------------------------------- /smalltalk/Parser/Parser.st: -------------------------------------------------------------------------------- 1 | Parser := Object [ 2 | 3 | | stream source atEnd | 4 | 5 | 6 | class parseString: aString [ 7 | ^self new initializeString: aString 8 | ] 9 | 10 | 11 | class parseStream: aStream [ 12 | ^(aStream isKindOf: CollectionStream) 13 | ifTrue: [self new initializeString: aStream contents] 14 | ifFalse: [self new initializeStream: aStream] 15 | ] 16 | 17 | 18 | initializeStream: aStream [ 19 | stream := aStream. 20 | source := aStream name. 21 | atEnd := false. 22 | ] 23 | 24 | 25 | initializeString: aString [ 26 | source := aString. 27 | atEnd := false. 28 | ] 29 | 30 | 31 | parseClass [ 32 | ^self signalIfException: [self basicParseClass] 33 | ] 34 | 35 | 36 | basicParseClass [ 37 | 38 | ] 39 | 40 | 41 | parseMethod [ 42 | ^self signalIfException: [self basicParseMethod] 43 | ] 44 | 45 | 46 | basicParseMethod [ 47 | 48 | ] 49 | 50 | 51 | parseMethodOrBlock [ 52 | ^self signalIfException: [self basicParseMethodOrBlock] 53 | ] 54 | 55 | 56 | basicParseMethodOrBlock [ 57 | 58 | ] 59 | 60 | 61 | signalIfException: aBlock [ 62 | | result | 63 | 64 | result := aBlock value. 65 | (result isKindOf: Exception) ifTrue: [result signal]. 66 | ^result 67 | ] 68 | 69 | 70 | atEnd [ 71 | ^atEnd 72 | ] 73 | 74 | ] 75 | -------------------------------------------------------------------------------- /smalltalk/Parser/StringNode.st: -------------------------------------------------------------------------------- 1 | StringNode := LiteralNode [ 2 | 3 | acceptVisitor: aVisitor [ 4 | aVisitor visitStringNode: self. 5 | ] 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /smalltalk/Parser/SymbolNode.st: -------------------------------------------------------------------------------- 1 | SymbolNode := LiteralNode [ 2 | 3 | acceptVisitor: aVisitor [ 4 | aVisitor visitSymbolNode: self. 5 | ] 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /smalltalk/Parser/TrueNode.st: -------------------------------------------------------------------------------- 1 | TrueNode := LiteralNode [ 2 | 3 | acceptVisitor: aVisitor [ 4 | aVisitor visitTrueNode: self. 5 | ] 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /smalltalk/Parser/VariableNode.st: -------------------------------------------------------------------------------- 1 | VariableNode := LiteralNode [ 2 | 3 | name [ 4 | ^self value 5 | ] 6 | 7 | 8 | acceptVisitor: aVisitor [ 9 | aVisitor visitVariableNode: self. 10 | ] 11 | 12 | ] 13 | -------------------------------------------------------------------------------- /smalltalk/Processes/Delay.st: -------------------------------------------------------------------------------- 1 | Delay := Object [ 2 | 3 | | microseconds | 4 | 5 | 6 | class forMicroseconds: anInteger [ 7 | ^super new initMicroseconds: anInteger 8 | ] 9 | 10 | 11 | class forMilliseconds: anInteger [ 12 | ^self forMicroseconds: anInteger * 1000 13 | ] 14 | 15 | 16 | class forSeconds: anInteger [ 17 | ^self forMicroseconds: anInteger * 1000000 18 | ] 19 | 20 | 21 | initMicroseconds: anInteger [ 22 | microseconds := anInteger. 23 | ] 24 | 25 | 26 | wait [ 27 | 28 | ] 29 | 30 | ] 31 | -------------------------------------------------------------------------------- /smalltalk/Processes/Process.st: -------------------------------------------------------------------------------- 1 | Process := Object [ 2 | 3 | terminate [ 4 | 5 | ] 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /smalltalk/Processes/ProcessorScheduler.st: -------------------------------------------------------------------------------- 1 | ProcessorScheduler := Object [ 2 | 3 | class initialize [ 4 | Processor := self new. 5 | ] 6 | 7 | 8 | thisProcess [ 9 | ^Process new 10 | ] 11 | 12 | ] 13 | -------------------------------------------------------------------------------- /smalltalk/Repl.st: -------------------------------------------------------------------------------- 1 | Repl := Object [ 2 | 3 | class autocomplete: aString [ 4 | | completions index part | 5 | 6 | completions := OrderedCollection new: 8. 7 | index := aString lastIndexOf: Character space. 8 | part := index > 0 9 | ifTrue: [aString copyFrom: index + 1] 10 | ifFalse: [aString]. 11 | 12 | SymbolTable do: [ :symbol | 13 | (symbol isNil not and: [symbol startsWith: part]) ifTrue: [ 14 | completions add: ((CollectionStream on: (String new: index + symbol size + 1)) 15 | nextPutAll: (aString copyFrom: 1 to: index); 16 | nextPutAll: symbol; 17 | nextPut: (Character codePoint: 0); 18 | contents)]]. 19 | ^completions 20 | ] 21 | 22 | 23 | class run [ 24 | | input compiler | 25 | 26 | input := self fileNamed: 'stdin'. 27 | compiler := Compiler new. 28 | [Transcript nextPutAll: 'Smalltalk> '. 29 | compiler evaluate: (input upTo: Character lf)] repeat. 30 | ] 31 | 32 | ] 33 | -------------------------------------------------------------------------------- /smalltalk/ShouldNotImplement.st: -------------------------------------------------------------------------------- 1 | ShouldNotImplement := Error [ 2 | 3 | "accessing" 4 | 5 | defaultMessageText [ 6 | ^'method should not be implemented' 7 | ] 8 | 9 | ] 10 | -------------------------------------------------------------------------------- /smalltalk/SourceCode.st: -------------------------------------------------------------------------------- 1 | SourceCode := Object [ 2 | 3 | | source position sourceSize line column | 4 | 5 | 6 | "accessing" 7 | 8 | source [ 9 | ^source 10 | ] 11 | 12 | 13 | position [ 14 | ^position 15 | ] 16 | 17 | 18 | sourceSize [ 19 | ^sourceSize 20 | ] 21 | 22 | 23 | sourceContents [ 24 | ^source 25 | ] 26 | 27 | 28 | line [ 29 | ^line 30 | ] 31 | 32 | 33 | column [ 34 | ^column 35 | ] 36 | 37 | 38 | "printing" 39 | 40 | printOn: aStream [ 41 | aStream nextPut: $'; nextPutAll: source; nextPut: $'; nextPut: $:. 42 | line printOn: aStream. 43 | aStream nextPut: $:. 44 | column printOn: aStream. 45 | ] 46 | 47 | ] 48 | -------------------------------------------------------------------------------- /smalltalk/Streams/BufferedStream.st: -------------------------------------------------------------------------------- 1 | BufferedStream := PositionableStream [ 2 | 3 | | buffer position buffered atEnd | 4 | 5 | 6 | "initialization" 7 | 8 | initialize [ 9 | buffer := self createBuffer. 10 | position := buffer size + 1. 11 | buffered := 0. 12 | ] 13 | 14 | 15 | createBuffer [ 16 | SubClassResponsibility signal. 17 | ] 18 | 19 | 20 | "accessing" 21 | 22 | peek [ 23 | self atEnd ifTrue: [^nil]. 24 | buffered = 0 ifTrue: [self bufferAtLeast: 1]. 25 | ^buffer at: position 26 | ] 27 | 28 | 29 | next [ 30 | | object | 31 | 32 | buffered = 0 ifTrue: [self bufferAtLeast: 1]. 33 | object := buffer at: position. 34 | position := position + 1. 35 | buffered := buffered - 1. 36 | ^object 37 | ] 38 | 39 | 40 | next: anInteger [ 41 | | collection | 42 | 43 | collection := buffer class new: anInteger. 44 | self next: anInteger into: collection startingAt: 1. 45 | ^collection 46 | ] 47 | 48 | 49 | contents [ 50 | | contents | 51 | contents := CollectionStream on: (buffer class new: buffer size). 52 | [self atEnd] whileFalse: [contents nextPut: self next]. 53 | ^contents contents 54 | ] 55 | 56 | 57 | "accessing private" 58 | 59 | next: anInteger into: aCollection startingAt: start [ 60 | | read rest | 61 | 62 | read := self nextAvailable: anInteger into: aCollection startingAt: 1. 63 | read = anInteger ifTrue: [^self]. 64 | 65 | rest := anInteger - read. 66 | rest > buffer size ifTrue: [ 67 | read := self directNext: rest into: aCollection startingAt: read + 1. 68 | atEnd := read < rest. 69 | read < rest ifTrue: [(OutOfRangeError value: rest between: 1 and: read) signal]. 70 | ^self]. 71 | 72 | self 73 | bufferAtLeast: rest; 74 | nextAvailable: rest into: aCollection startingAt: read + 1. 75 | ] 76 | 77 | 78 | nextAvailable: anInteger into: aCollection startingAt: start [ 79 | | available | 80 | 81 | buffered = 0 ifTrue: [^0]. 82 | available := anInteger min: buffered. 83 | aCollection replaceFrom: start to: start + available - 1 with: buffer startingAt: position. 84 | position := position + available. 85 | buffered := buffered - available. 86 | ^available 87 | ] 88 | 89 | 90 | bufferAtLeast: least [ 91 | position := 1. 92 | buffered := self directNext: buffer size into: buffer startingAt: 1. 93 | atEnd := buffered < buffer size. 94 | buffered < least ifTrue: [(OutOfRangeError value: least between: 1 and: buffered) signal]. 95 | ] 96 | 97 | 98 | directNext: anInteger into: aCollection startingAt: start [ 99 | SubClassResponsibility signal. 100 | ] 101 | 102 | 103 | "testing" 104 | 105 | atEnd [ 106 | atEnd isNil ifTrue: [self bufferAtLeast: 0]. 107 | ^atEnd and: [buffered == 0] 108 | ] 109 | 110 | ] 111 | -------------------------------------------------------------------------------- /smalltalk/Streams/CollectionStream.st: -------------------------------------------------------------------------------- 1 | CollectionStream := PositionableStream [ 2 | 3 | | collection position end | 4 | 5 | 6 | "instance creation" 7 | 8 | class on: aCollection [ 9 | ^self new 10 | initializeCollection: aCollection 11 | from: 1 12 | to: aCollection size + 1 13 | ] 14 | 15 | 16 | class with: aCollection [ 17 | ^self new 18 | initializeCollection: aCollection 19 | from: 1 20 | to: 1 21 | ] 22 | 23 | 24 | "initializing" 25 | 26 | initializeCollection: aCollection from: aPos to: anEnd [ 27 | collection := aCollection. 28 | position := aPos. 29 | end := anEnd. 30 | ] 31 | 32 | 33 | "testing" 34 | 35 | isEmpty [ 36 | ^position = 1 37 | ] 38 | 39 | 40 | "accessing" 41 | 42 | peek [ 43 | self atEnd ifTrue: [^nil]. 44 | ^collection at: position 45 | ] 46 | 47 | 48 | next [ 49 | | object | 50 | 51 | self atEnd ifTrue: [^nil]. 52 | object := collection at: position. 53 | position := position + 1. 54 | ^object 55 | ] 56 | 57 | 58 | next: anInteger [ 59 | | newPos result | 60 | 61 | newPos := position + anInteger. 62 | result := collection copyFrom: position to: newPos - 1. 63 | position := newPos. 64 | ^result 65 | ] 66 | 67 | 68 | nextAvailablePutAllOn: aStream [ 69 | [self atEnd] whileFalse: [aStream nextPut: self next]. 70 | ] 71 | 72 | 73 | putAllOn: aStream [ 74 | 1 to: end - 1 do: [ :i | aStream nextPut: (collection at: i)]. 75 | ] 76 | 77 | 78 | nextPut: anObject [ 79 | position > collection size ifTrue: [collection := collection copyResized: position * 2]. 80 | collection at: position put: anObject. 81 | position := position + 1. 82 | end := end max: position. 83 | ^anObject 84 | ] 85 | 86 | 87 | atEnd [ 88 | ^position >= end 89 | ] 90 | 91 | 92 | contents [ 93 | ^collection copyFrom: 1 to: end - 1 94 | ] 95 | 96 | 97 | upToEnd [ 98 | ^collection copyFrom: position to: end - 1 99 | ] 100 | 101 | 102 | size [ 103 | ^end - 1 104 | ] 105 | 106 | 107 | "positioning" 108 | 109 | position [ 110 | ^position 111 | ] 112 | 113 | 114 | position: anInteger [ 115 | (anInteger < 1 or: [anInteger > end]) ifTrue: [Error signal]. 116 | position := anInteger. 117 | ] 118 | 119 | 120 | reset [ 121 | position := 1. 122 | end := 1. 123 | ] 124 | 125 | 126 | setToEnd [ 127 | position := end. 128 | ] 129 | 130 | 131 | species [ 132 | ^collection class 133 | ] 134 | 135 | ] 136 | -------------------------------------------------------------------------------- /smalltalk/Streams/ExternalStream.st: -------------------------------------------------------------------------------- 1 | ExternalStream := BufferedStream [ 2 | 3 | | descriptor | 4 | 5 | 6 | "class initialization" 7 | 8 | class initialize [ 9 | Transcript := self descriptor: 1. 10 | ] 11 | 12 | 13 | "instance creation" 14 | 15 | class descriptor: anInteger [ 16 | ^self new initializeDescriptor: anInteger 17 | ] 18 | 19 | 20 | "initialization" 21 | 22 | initializeDescriptor: anInteger [ 23 | descriptor := anInteger. 24 | self initialize. 25 | ] 26 | 27 | 28 | createBuffer [ 29 | ^String new: 2048 30 | ] 31 | 32 | 33 | "IO primitives" 34 | 35 | class read: descriptor next: anInteger into: aString startingAt: start [ 36 | 37 | IoError last signal. 38 | ] 39 | 40 | 41 | class write: descriptor next: anInteger from: aString [ 42 | 43 | IoError last signal. 44 | ] 45 | 46 | 47 | class close: descriptor [ 48 | 49 | IoError last signal. 50 | ] 51 | 52 | 53 | class flush: descriptor [ 54 | 55 | IoError last signal. 56 | ] 57 | 58 | 59 | class position: descriptor [ 60 | 61 | IoError last signal. 62 | ] 63 | 64 | 65 | class position: descriptor to: anInteger[ 66 | 67 | IoError last signal. 68 | ] 69 | 70 | 71 | class available: descriptor [ 72 | 73 | IoError last signal. 74 | ] 75 | 76 | 77 | "accessing" 78 | 79 | nextPut: aCharacter [ 80 | buffer at: 1 put: aCharacter. 81 | self class write: descriptor next: 1 from: buffer. 82 | "self flush." 83 | ] 84 | 85 | 86 | nextPutAll: aCollection [ 87 | self class write: descriptor next: aCollection size from: aCollection. 88 | ] 89 | 90 | 91 | "accessing private" 92 | 93 | directNext: anInteger into: aCollection startingAt: start [ 94 | | read lastRead | 95 | 96 | read := 0. 97 | [lastRead := self class read: descriptor next: anInteger into: aCollection startingAt: start. 98 | read := read + lastRead. 99 | read < anInteger and: [lastRead > 0]] whileTrue. 100 | 101 | ^read 102 | ] 103 | 104 | 105 | "positioning" 106 | 107 | position [ 108 | ^(self class position: descriptor) - buffered + 1 109 | ] 110 | 111 | 112 | position: anInteger [ 113 | self class position: descriptor to: anInteger - 1. 114 | position := buffer size + 1. 115 | buffered := 0. 116 | ] 117 | 118 | 119 | "flushing" 120 | 121 | flush [ 122 | self class flush: descriptor. 123 | ] 124 | 125 | 126 | "closing" 127 | 128 | close [ 129 | self class close: descriptor. 130 | ] 131 | 132 | 133 | finalize [ 134 | self close. 135 | ] 136 | 137 | 138 | species [ 139 | ^buffer class 140 | ] 141 | 142 | ] 143 | -------------------------------------------------------------------------------- /smalltalk/Streams/FileStream.st: -------------------------------------------------------------------------------- 1 | FileStream := ExternalStream [ 2 | 3 | | name | 4 | 5 | 6 | "instance creation" 7 | 8 | class read: aString [ 9 | ^self new initializeFileName: aString mode: 1 10 | ] 11 | 12 | 13 | class write: aString [ 14 | ^self new initializeFileName: aString mode: 2 15 | ] 16 | 17 | 18 | class readOrWrite: aString [ 19 | ^self new initializeFileName: aString mode: 3 20 | ] 21 | 22 | 23 | "IO primitives" 24 | 25 | class open: aString mode: anInteger [ 26 | 27 | IoError last appendName: aString; signal. 28 | ] 29 | 30 | 31 | initializeFileName: aString mode: anInteger [ 32 | name := aString. 33 | self initializeDescriptor: (self class open: aString mode: anInteger). 34 | ] 35 | 36 | 37 | "accessing" 38 | 39 | name [ 40 | ^name 41 | ] 42 | 43 | ] 44 | -------------------------------------------------------------------------------- /smalltalk/Streams/InternetAddress.st: -------------------------------------------------------------------------------- 1 | InternetAddress := Object [ 2 | 3 | | address | 4 | 5 | 6 | "instance creation" 7 | 8 | class lookup: aString [ 9 | 10 | Error signal. 11 | ] 12 | 13 | 14 | "printing" 15 | 16 | printOn: aStream [ 17 | (address bitAnd: 16rFF) printOn: aStream. 18 | aStream nextPut: $.. 19 | ((address bitAnd: 16rFF00) bitShift: -8) printOn: aStream. 20 | aStream nextPut: $.. 21 | ((address bitAnd: 16rFF0000) bitShift: -16) printOn: aStream. 22 | aStream nextPut: $.. 23 | ((address bitAnd: 16rFF000000) bitShift: -24) printOn: aStream. 24 | ] 25 | 26 | ] 27 | -------------------------------------------------------------------------------- /smalltalk/Streams/PositionableStream.st: -------------------------------------------------------------------------------- 1 | PositionableStream := Stream [ 2 | 3 | "accessing" 4 | 5 | peek [ 6 | SubClassResponsibility signal. 7 | ] 8 | 9 | 10 | peekFor: anObject [ 11 | self peek = anObject ifTrue: [ 12 | self next. 13 | ^true]. 14 | ^false 15 | ] 16 | 17 | 18 | upTo: anObject [ 19 | | stream object | 20 | 21 | stream := CollectionStream with: (String new: 100). 22 | 23 | [self atEnd or: [(object := self next) = anObject]] whileFalse: [ 24 | stream nextPut: object]. 25 | ^stream contents 26 | ] 27 | 28 | 29 | upToAll: aCollection [ 30 | | result prefix ch j resultColl | 31 | 32 | self atEnd ifTrue: [^self species new]. 33 | aCollection isEmpty ifTrue: [^self species new]. 34 | result := CollectionStream with: (self species new: 32). 35 | 36 | "Use the Knuth-Morris-Pratt algorithm." 37 | prefix := self prefixTableFor: aCollection. 38 | ch := self next. 39 | j := 1. 40 | result nextPut: ch. 41 | 42 | [ 43 | (ch = (aCollection at: j) or: [(j := prefix at: j) = 0]) ifTrue: [ 44 | j := j + 1. 45 | j > prefix size ifTrue: [ 46 | "TODO: CollectionStream#contents returns whole contents not just up to pointer 47 | result skip: aCollection size negated." 48 | resultColl := result contents. 49 | ^resultColl copyFrom: 1 to: resultColl size - aCollection size 50 | ]. 51 | self atEnd ifTrue: [^result contents]. 52 | ch := self next. 53 | result nextPut: ch. 54 | ]. 55 | ] repeat. 56 | ] 57 | 58 | 59 | "private" 60 | 61 | prefixTableFor: aCollection [ 62 | | prefix j | 63 | 64 | prefix := aCollection size < 256 65 | ifTrue: [ByteArray new: aCollection size] 66 | ifFalse: [Array new: aCollection size]. 67 | prefix 68 | at: 1 put: 0; 69 | at: 2 put: 1. 70 | 71 | 2 to: aCollection size - 1 do: [ :i | | ch | 72 | ch := aCollection at: i. 73 | j := prefix at: i. 74 | [j <= 1 or: [ch = (aCollection at: j)]] whileFalse: [j := prefix at: j]. 75 | prefix at: i + 1 put: j. 76 | ]. 77 | 78 | ^prefix 79 | ] 80 | 81 | 82 | "positioning" 83 | 84 | position [ 85 | SubClassResponsibility signal. 86 | ] 87 | 88 | 89 | position: anInteger [ 90 | SubClassResponsibility signal. 91 | ] 92 | 93 | 94 | reset [ 95 | SubClassResponsibility signal. 96 | ] 97 | 98 | 99 | setToEnd [ 100 | SubClassResponsibility signal. 101 | ] 102 | 103 | 104 | skip: anInteger [ 105 | self position: self position + anInteger. 106 | ] 107 | 108 | 109 | skipTo: anObject [ 110 | SubClassResponsibility signal. 111 | ] 112 | 113 | 114 | "testing" 115 | 116 | isEmpty [ 117 | SubClassResponsibility signal. 118 | ] 119 | 120 | ] 121 | -------------------------------------------------------------------------------- /smalltalk/Streams/ServerSocket.st: -------------------------------------------------------------------------------- 1 | ServerSocket := Object [ 2 | 3 | | descriptor | 4 | 5 | 6 | "instance creation" 7 | 8 | class bindTo: address port: port queueSize: queueSize [ 9 | ^self new initializeAddress: address port: port queueSize: queueSize 10 | ] 11 | 12 | 13 | class bind: address port: port queueSize: queueSize [ 14 | 15 | IoError last signal. 16 | ] 17 | 18 | 19 | "initialization" 20 | 21 | initializeAddress: address port: port queueSize: queueSize [ 22 | descriptor := self class bind: address port: port queueSize: queueSize. 23 | ] 24 | 25 | 26 | accept [ 27 | ^Socket descriptor: self basicAccept 28 | ] 29 | 30 | 31 | basicAccept [ 32 | 33 | ] 34 | 35 | 36 | close [ 37 | ExternalStream close: descriptor. 38 | ] 39 | 40 | ] 41 | -------------------------------------------------------------------------------- /smalltalk/Streams/Socket.st: -------------------------------------------------------------------------------- 1 | Socket := ExternalStream [ 2 | 3 | "instance creation" 4 | 5 | class connectTo: address port: port [ 6 | ^self new initializeAddress: address port: port 7 | ] 8 | 9 | 10 | class connect: address port: port [ 11 | 12 | ] 13 | 14 | 15 | "initialization" 16 | 17 | initializeAddress: address port: port [ 18 | self initializeDescriptor: (self class connect: address port: port). 19 | ] 20 | 21 | 22 | "accessing private" 23 | 24 | directNext: anInteger into: aCollection startingAt: start [ 25 | | size | 26 | 27 | size := ((self class available: descriptor) min: anInteger) max: 1. 28 | ^self class read: descriptor next: size into: aCollection startingAt: start 29 | ] 30 | 31 | 32 | "flushing" 33 | 34 | flush [ 35 | 36 | ] 37 | 38 | 39 | "testing" 40 | 41 | atEnd [ 42 | ^false 43 | ] 44 | 45 | ] 46 | -------------------------------------------------------------------------------- /smalltalk/Streams/Stream.st: -------------------------------------------------------------------------------- 1 | Stream := Iterator [ 2 | 3 | "accessing" 4 | 5 | next [ 6 | SubClassResponsibility signal. 7 | ] 8 | 9 | 10 | next: anInteger [ 11 | SubClassResponsibility signal. 12 | ] 13 | 14 | 15 | nextMatchFor: anObject [ 16 | ^self next = anObject 17 | ] 18 | 19 | 20 | contents [ 21 | SubClassResponsibility signal. 22 | ] 23 | 24 | 25 | nextPut: anObject [ 26 | SubClassResponsibility signal. 27 | ] 28 | 29 | 30 | nextPutAll: aCollection [ 31 | aCollection do: [ :v | self nextPut: v]. 32 | ^aCollection 33 | ] 34 | 35 | 36 | next: anInteger put: anObject [ 37 | anInteger timesRepeat: [self nextPut: anObject]. 38 | ] 39 | 40 | 41 | cr [ 42 | self nextPut: Character cr. 43 | ] 44 | 45 | 46 | lf [ 47 | self nextPut: Character lf. 48 | ] 49 | 50 | 51 | space [ 52 | self nextPut: Character space. 53 | ] 54 | 55 | 56 | tab [ 57 | self nextPut: Character tab. 58 | ] 59 | 60 | 61 | tab: anInteger [ 62 | self next: anInteger put: Character tab. 63 | ] 64 | 65 | 66 | "testing" 67 | 68 | atEnd [ 69 | SubClassResponsibility signal. 70 | ] 71 | 72 | 73 | "enumerating" 74 | 75 | do: aBlock [ 76 | [self atEnd] whileFalse: [aBlock value: self next]. 77 | ] 78 | 79 | ] 80 | -------------------------------------------------------------------------------- /smalltalk/Streams/StreamView.st: -------------------------------------------------------------------------------- 1 | StreamView := PositionableStream [ 2 | 3 | | stream position limit | 4 | 5 | 6 | class on: aStream limit: anInteger [ 7 | ^super new initializeStream: aStream limit: anInteger 8 | ] 9 | 10 | 11 | initializeStream: aStream limit: anInteger [ 12 | stream := aStream. 13 | position := 1. 14 | limit := anInteger. 15 | ] 16 | 17 | 18 | "accessing" 19 | 20 | next [ 21 | position > limit ifTrue: [Error signal]. 22 | position := position + 1. 23 | ^stream next 24 | ] 25 | 26 | 27 | next: anInteger [ 28 | | newPosition | 29 | 30 | newPosition := position + anInteger. 31 | (newPosition - limit > 1) ifTrue: [Error signal]. 32 | position := newPosition. 33 | ^stream next: anInteger 34 | ] 35 | 36 | 37 | contents [ 38 | | contents | 39 | 40 | contents := stream contents. 41 | contents size > limit ifTrue: [contents := contents copyFrom: 1 to: limit]. 42 | ^contents 43 | ] 44 | 45 | 46 | nextPut: anObject [ 47 | ShouldNotImplement signal. 48 | ] 49 | 50 | 51 | peek [ 52 | position > limit ifTrue: [^nil]. 53 | ^stream peek 54 | ] 55 | 56 | 57 | "positioning" 58 | 59 | position [ 60 | ^position 61 | ] 62 | 63 | 64 | position: anInteger [ 65 | anInteger > limit ifTrue: [Error signal]. 66 | stream position: anInteger. 67 | position := anInteger. 68 | ] 69 | 70 | 71 | reset [ 72 | position := 1. 73 | stream reset. 74 | ] 75 | 76 | 77 | setToEnd [ 78 | stream position: limit. 79 | ] 80 | 81 | 82 | skip: anInteger [ 83 | self position: position + anInteger. 84 | ] 85 | 86 | 87 | "testing" 88 | 89 | atEnd [ 90 | ^position = limit or: [stream atEnd] 91 | ] 92 | 93 | ] 94 | -------------------------------------------------------------------------------- /smalltalk/SubClassResponsibility.st: -------------------------------------------------------------------------------- 1 | SubClassResponsibility := Error [ 2 | 3 | "accessing" 4 | 5 | defaultMessageText [ 6 | ^'called method is responsibility of sub class' 7 | ] 8 | 9 | ] 10 | -------------------------------------------------------------------------------- /smalltalk/True.st: -------------------------------------------------------------------------------- 1 | True := Boolean [ 2 | 3 | "logical operations" 4 | 5 | & aBoolean [ 6 | ^aBoolean 7 | ] 8 | 9 | 10 | not [ 11 | ^false 12 | ] 13 | 14 | 15 | | aBoolean [ 16 | ^self 17 | ] 18 | 19 | 20 | "controlling" 21 | 22 | ifTrue: aBlock [ 23 | ^aBlock value 24 | ] 25 | 26 | 27 | ifFalse: aBlock [ 28 | ^nil 29 | ] 30 | 31 | 32 | ifTrue: aTrueBlock ifFalse: aFalseBlock [ 33 | ^aTrueBlock value 34 | ] 35 | 36 | 37 | ifFalse: aFalseBlock ifTrue: aTrueBlock [ 38 | ^aTrueBlock value 39 | ] 40 | 41 | 42 | and: aBlock [ 43 | ^aBlock value 44 | ] 45 | 46 | 47 | or: aBlock [ 48 | ^self 49 | ] 50 | 51 | 52 | "printing" 53 | 54 | printOn: aStream [ 55 | aStream nextPutAll: 'true'. 56 | ] 57 | 58 | ] 59 | -------------------------------------------------------------------------------- /smalltalk/TypeFeedback.st: -------------------------------------------------------------------------------- 1 | TypeFeedback := Object [ 2 | 3 | | ic hintedClass | 4 | 5 | ] 6 | -------------------------------------------------------------------------------- /smalltalk/UndefinedObject.st: -------------------------------------------------------------------------------- 1 | UndefinedObject := Object [ 2 | 3 | "testing" 4 | 5 | isNil [ 6 | ^true 7 | ] 8 | 9 | 10 | "copying" 11 | 12 | copy [ 13 | ^self 14 | ] 15 | 16 | 17 | "printing" 18 | 19 | printOn: aStream [ 20 | aStream nextPutAll: 'nil'. 21 | ] 22 | 23 | ] 24 | -------------------------------------------------------------------------------- /smalltalk/VMTools.st: -------------------------------------------------------------------------------- 1 | VMTools := Object [ 2 | 3 | class printCCharacters [ 4 | 0 to: 255 do: [ :i | 5 | | ch defined | 6 | defined := nil. 7 | ch := Character codePoint: i. 8 | "Transcript nextPutAll: '/*'. 9 | ch printOn: Transcript. 10 | Transcript nextPutAll: '*/ '." 11 | ('0123456789' includes: ch) 12 | ifTrue: [ 13 | Transcript nextPutAll: 'NUM'. 14 | defined := true]. 15 | ('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ' includes: ch) 16 | ifTrue: [ 17 | Transcript nextPutAll: 'LET'. 18 | defined := true]. 19 | (ch = Character space or: [ch = Character tab or: [ch = Character lf or: [ch = (Character codePoint: 13)]]]) 20 | ifTrue: [ 21 | Transcript nextPutAll: 'SEP'. 22 | defined := true]. 23 | ('!%&*+,-/<=>?@\|~' includes: ch) 24 | ifTrue: [ 25 | Transcript nextPutAll: 'SPEC'. 26 | defined := true]. 27 | defined isNil ifTrue: [Transcript nextPut: $0]. 28 | (i + 1) \\ 8 = 0 29 | ifTrue: [Transcript nextPut: $,; lf] 30 | ifFalse: [Transcript nextPutAll: ', ']. 31 | ] 32 | ] 33 | 34 | 35 | class printCCharacterClasses [ 36 | 0 to: 255 do: [ :i | 37 | | ch | 38 | ch := Character codePoint: i. 39 | ('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_' includes: ch) 40 | ifTrue: [Transcript nextPutAll: 'IDENT_BEGIN'] 41 | ifFalse: [ 42 | ('0123456789' includes: ch) 43 | ifTrue: [Transcript nextPutAll: 'IDENT'] 44 | ifFalse: [Transcript nextPut: $0]]. 45 | (i + 1) \\ 8 = 0 46 | ifTrue: [Transcript nextPut: $,; lf] 47 | ifFalse: [Transcript nextPutAll: ', ']. 48 | ]. 49 | ] 50 | 51 | 52 | class printCCharacterDigitValues [ 53 | 0 to: 255 do: [ :i | 54 | | ch | 55 | ch := Character codePoint: i. 56 | (ch isDigit: 36) 57 | ifTrue: [ch digitValue printOn: Transcript] 58 | ifFalse: [Transcript nextPutAll: '36']. 59 | (i + 1) \\ 8 = 0 60 | ifTrue: [Transcript nextPut: $,; lf] 61 | ifFalse: [Transcript nextPutAll: ', ']]. 62 | ] 63 | 64 | ] 65 | -------------------------------------------------------------------------------- /test: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | echo "--- Bootstrap" 4 | ./st -b smalltalk -e "#Ok" 5 | echo "--- Array test" 6 | ./st -f tests/ArrayTest.st 7 | echo "--- Behavior test" 8 | ./st -f tests/BehaviorTest.st 9 | echo "--- Block test" 10 | ./st -f tests/BlockTest.st 11 | echo "--- Character test" 12 | ./st -f tests/CharacterTest.st 13 | echo "--- CollectionStream test" 14 | ./st -f tests/CollectionStreamTest.st 15 | echo "--- Compiler test" 16 | ./st -f tests/CompilerTest.st 17 | echo "--- Exception test" 18 | ./st -f tests/ExceptionTest.st 19 | echo "--- Number test" 20 | ./st -f tests/NumberTest.st 21 | echo "--- Object test" 22 | ./st -f tests/ObjectTest.st 23 | echo "--- OrderedCollection test" 24 | ./st -f tests/OrderedCollectionTest.st 25 | echo "--- OuterReturn test" 26 | ./st -f tests/OuterReturnTest.st 27 | echo "--- Parser test" 28 | ./st -f tests/ParserTest.st 29 | echo "--- RegAlloc test" 30 | ./st -f tests/RegAllocTest.st 31 | echo "--- SmallInteger test" 32 | ./st -f tests/SmallIntegerTest.st 33 | echo "--- StreamView test" 34 | ./st -f tests/StreamViewTest.st 35 | echo "--- String test" 36 | ./st -f tests/StringTest.st 37 | echo "--- UndefinedObject test" 38 | ./st -f tests/UndefinedObjectTest.st 39 | -------------------------------------------------------------------------------- /tests/ArrayTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | | array | 3 | 4 | array := Array new: 2. 5 | 6 | Assert true: array size = 2. 7 | Assert true: (array at: 1) isNil. 8 | Assert true: (array at: 2) isNil. 9 | Assert true: (array at: 1 put: 3) = 3. 10 | ] 11 | 12 | [ 13 | Assert true: (Array with: 1 with: 2) = (Array with: 1 with: 2). 14 | Assert true: (Array with: 1 with: 2) ~= (Array with: 1 with: 3). 15 | 16 | Assert true: (Array with: 1 with: 2) hash = (Array with: 1 with: 2) hash. 17 | Assert true: (Array with: 1 with: 2) hash ~= (Array with: 1 with: 3) hash. 18 | ] 19 | -------------------------------------------------------------------------------- /tests/BehaviorTest.st: -------------------------------------------------------------------------------- 1 | BehaviorFooClass := Object [ 2 | 3 | foo [ 4 | 5 | ] 6 | 7 | ] 8 | 9 | [ 10 | Assert true: BehaviorFooClass superClass == Object. 11 | Assert true: (Object subClasses includes: BehaviorFooClass). 12 | Assert true: (BehaviorFooClass methodDictionary size = 1). 13 | Assert true: (BehaviorFooClass methodDictionary includesKey: #foo). 14 | Assert true: (BehaviorFooClass inheritsFrom: Object). 15 | Assert false: (BehaviorFooClass inheritsFrom: UndefinedObject). 16 | Assert true: (BehaviorFooClass selectors includes: #foo). 17 | Assert true: (BehaviorFooClass allSelectors includes: #foo). 18 | Assert true: (BehaviorFooClass allSelectors includes: #isNil). 19 | Assert true: (BehaviorFooClass compiledMethodAt: #foo) notNil. 20 | 21 | Assert do: [Object new: Object] expect: Error. 22 | ] 23 | -------------------------------------------------------------------------------- /tests/BlockTest.st: -------------------------------------------------------------------------------- 1 | BlockTest := Object [ 2 | 3 | class outerReturn [ 4 | [^1] value. 5 | ] 6 | 7 | ] 8 | 9 | [ 10 | Assert true: [] value isNil. 11 | Assert true: [1] value = 1. 12 | Assert true: BlockTest outerReturn = 1. 13 | ] 14 | 15 | [ 16 | Assert do: [[ :a | ] value] expect: OutOfRangeError. 17 | Assert do: [[ :a | ] value: 1 value: 2] expect: OutOfRangeError. 18 | ] 19 | 20 | [ 21 | | block | 22 | 23 | block := [false]. 24 | Assert true: block whileTrue == block. 25 | Assert true: (block whileTrue: []) == block. 26 | ] 27 | 28 | [ 29 | Assert do: [[] whileTrue] expect: Error. 30 | Assert do: [[1] whileTrue] expect: Error. 31 | Assert do: [[Object] whileTrue] expect: Error. 32 | Assert do: [[] whileTrue: []] expect: Error. 33 | Assert do: [[1] whileTrue: []] expect: Error. 34 | Assert do: [[Object] whileTrue: []] expect: Error. 35 | ] 36 | -------------------------------------------------------------------------------- /tests/CharacterTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | Assert true: Character space isSeparator. 3 | ] 4 | -------------------------------------------------------------------------------- /tests/CollectionStreamTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | | stream | 3 | 4 | stream := CollectionStream on: 'abbccdd'. 5 | 6 | Assert true: stream peek = $a. 7 | Assert true: stream peek = $a. 8 | 9 | Assert true: stream next = $a. 10 | Assert true: (stream next: 2) = 'bb'. 11 | Assert true: (stream next: 2) = 'cc'. 12 | Assert true: stream next = $d. 13 | Assert do: [stream next: 2] expect: OutOfRangeError. 14 | 15 | stream := CollectionStream on: 'foo' copy. 16 | Assert true: stream contents = 'foo' copy. 17 | Assert true: stream upToEnd = 'foo' copy. 18 | 19 | stream next. 20 | Assert true: stream contents = 'foo' copy. 21 | Assert true: stream upToEnd = 'oo' copy. 22 | 23 | stream := CollectionStream with: (String new: 1). 24 | stream nextPut: $a; nextPut: $a. 25 | stream nextPutAll: 'bb'. 26 | Assert true: stream contents = 'aabb' copy. 27 | 28 | stream := CollectionStream on: 'abc' copy. 29 | stream next; nextPut: $x. 30 | Assert true: stream contents = 'axc' copy. 31 | stream nextPutAll: 'xx'. 32 | Assert true: stream contents = 'axxx' copy. 33 | 34 | stream := CollectionStream with: 'abc' copy. 35 | Assert true: stream atEnd. 36 | 37 | stream := CollectionStream on: 'abc' copy. 38 | Assert false: stream atEnd. 39 | stream next: 2. 40 | Assert false: stream atEnd. 41 | stream next. 42 | Assert true: stream atEnd. 43 | ] 44 | -------------------------------------------------------------------------------- /tests/CompilerTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | | compiler | 3 | 4 | compiler := Compiler new. 5 | 6 | Assert true: (compiler evaluate: '1') == 1. 7 | Assert true: (compiler evaluate: '^1') == 1. 8 | Assert true: (compiler evaluate: 'self') == nil. 9 | Assert true: (compiler evaluate: '| a | a := 1. a') == 1. 10 | Assert do: [compiler evaluate: 'self foo'] expect: MessageNotUnderstood. 11 | Assert true: Foo isNil. 12 | compiler includeFile: 'tests/CompilerTestFile.st'. 13 | Assert true: Foo notNil. 14 | ] 15 | 16 | CompilerTestClassA := Object [ 17 | 18 | | ClassVar | 19 | 20 | 21 | defineClassVar [ 22 | ClassVar := 1 23 | ] 24 | 25 | ] 26 | 27 | 28 | CompilerTestClassB := CompilerTestClassA [ 29 | 30 | classVar [ 31 | ^ClassVar 32 | ] 33 | 34 | ] 35 | 36 | 37 | [ 38 | | object | 39 | 40 | object := CompilerTestClassB new. 41 | Assert true: object classVar isNil. 42 | object defineClassVar. 43 | Assert true: object classVar = 1. 44 | ] 45 | -------------------------------------------------------------------------------- /tests/CompilerTestFile.st: -------------------------------------------------------------------------------- 1 | Foo := Object [ 2 | 3 | ] 4 | -------------------------------------------------------------------------------- /tests/ExceptionTest.st: -------------------------------------------------------------------------------- 1 | ExceptionTest := Object [ 2 | 3 | class outerReturnWithinHandleBlock [ 4 | [Exception signal] on: Exception do: [ :e | ^e]. 5 | ] 6 | 7 | 8 | class outerReturnWithinBlock [ 9 | [^1] on: Exception do: [ :e | ]. 10 | ] 11 | 12 | 13 | class outerReturnWithinBlockOfBlock [ 14 | [[^1] value] on: Exception do: [ :e | ]. 15 | ] 16 | 17 | ] 18 | 19 | 20 | [ 21 | | exception | 22 | 23 | exception := Exception new. 24 | [exception signal] on: Exception do: [ :e | Assert true: e == exception]. 25 | [Error signal] on: Exception do: [ :e | Assert true: e ~= exception]. 26 | ] 27 | 28 | 29 | [ 30 | Assert true: (ExceptionTest outerReturnWithinHandleBlock isMemberOf: Exception). 31 | Assert true: ExceptionTest outerReturnWithinBlock = 1. 32 | Assert true: ExceptionTest outerReturnWithinBlockOfBlock = 1. 33 | ] 34 | -------------------------------------------------------------------------------- /tests/NumberTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | Assert true: (Number readFrom: (CollectionStream on: '1234567890')) = 1234567890. 3 | Assert true: (Number readFrom: (CollectionStream on: 'FF') base: 16) = 16rFF. 4 | ] 5 | -------------------------------------------------------------------------------- /tests/ObjectTest.st: -------------------------------------------------------------------------------- 1 | TestIndexedObject := Object [ 2 | 3 | 4 | 5 | ] 6 | 7 | 8 | [ 9 | | object stream | 10 | 11 | object := Object new. 12 | 13 | Assert do: [object at: -1] expect: OutOfRangeError. 14 | Assert do: [object at: 0] expect: OutOfRangeError. 15 | Assert do: [object at: 1] expect: OutOfRangeError. 16 | 17 | Assert do: [object at: -1 put: nil] expect: OutOfRangeError. 18 | Assert do: [object at: 0 put: nil] expect: OutOfRangeError. 19 | Assert do: [object at: 1 put: nil] expect: OutOfRangeError. 20 | 21 | Assert do: [object basicAt: -1] expect: OutOfRangeError. 22 | Assert do: [object basicAt: 0] expect: OutOfRangeError. 23 | Assert do: [object basicAt: 1] expect: OutOfRangeError. 24 | 25 | Assert do: [object basicAt: -1 put: nil] expect: OutOfRangeError. 26 | Assert do: [object basicAt: 0 put: nil] expect: OutOfRangeError. 27 | Assert do: [object basicAt: 1 put: nil] expect: OutOfRangeError. 28 | 29 | Assert true: object size == 0. 30 | Assert true: object basicSize == 0. 31 | Assert true: object yourself == object. 32 | 33 | Assert do: [object instVarAt: -1] expect: OutOfRangeError. 34 | Assert do: [object instVarAt: 0] expect: OutOfRangeError. 35 | Assert do: [object instVarAt: 1] expect: OutOfRangeError. 36 | 37 | Assert do: [object instVarAt: -1 put: nil] expect: OutOfRangeError. 38 | Assert do: [object instVarAt: 0 put: nil] expect: OutOfRangeError. 39 | Assert do: [object instVarAt: 1 put: nil] expect: OutOfRangeError. 40 | 41 | Assert true: object = object. 42 | Assert false: object = nil. 43 | 44 | Assert true: object == object. 45 | Assert false: object == nil. 46 | 47 | Assert true: object hash > 0. 48 | 49 | Assert false: object ~= object. 50 | Assert true: object ~= nil. 51 | 52 | Assert false: object ~~ object. 53 | Assert true: object ~= nil. 54 | 55 | Assert true: object identityHash > 0. 56 | 57 | Assert true: object class == Object. 58 | Assert true: (object isKindOf: Object). 59 | Assert false: (object isKindOf: SmallInteger). 60 | Assert true: (1 isKindOf: Object). 61 | Assert true: (object isMemberOf: Object). 62 | Assert false: (object isMemberOf: SmallInteger). 63 | Assert true: (object respondsTo: #size). 64 | Assert false: (object respondsTo: #foo). 65 | 66 | "Assert do: [object doesNotUnderstand: ]" 67 | 68 | Assert true: object printString = 'an Object'. 69 | stream := CollectionStream with: (String new: 32). 70 | object examineOn: stream. 71 | Assert true: stream contents = ('an Object' copyWith: Character lf). 72 | ] 73 | 74 | 75 | [ 76 | | object | 77 | 78 | object := TestIndexedObject new: 8. 79 | 80 | Assert do: [object at: -1] expect: OutOfRangeError. 81 | Assert true: (object at: 1) == nil. 82 | Assert true: (object at: 8) == nil. 83 | Assert do: [object at: 9] expect: OutOfRangeError. 84 | 85 | Assert do: [object at: -1 put: nil] expect: OutOfRangeError. 86 | Assert do: [object at: 9 put: nil] expect: OutOfRangeError. 87 | 88 | object at: 1 put: 1. 89 | Assert true: (object at: 1) == 1. 90 | object at: 8 put: 2. 91 | Assert true: (object at: 8) == 2. 92 | 93 | Assert true: object size == 8. 94 | Assert true: object basicSize == 8. 95 | 96 | Assert true: object printString = 'a TestIndexedObject'. 97 | ] 98 | 99 | 100 | [ 101 | | object object2 | 102 | 103 | object := Object new. 104 | object2 := Object new. 105 | object become: object2. 106 | Assert true: object identityHash == object2 identityHash. 107 | ] 108 | 109 | 110 | [ 111 | | object object2 | 112 | 113 | object := TestIndexedObject new: 0. 114 | object2 := TestIndexedObject new: 1. 115 | 116 | object become: object2. 117 | Assert true: object identityHash == object2 identityHash. 118 | ] 119 | 120 | 121 | [ 122 | | object | 123 | 124 | object := Object new. 125 | 126 | Assert false: object == object shallowCopy. 127 | Assert false: object = object shallowCopy. 128 | 129 | object := Array new: 16. 130 | object at: 1 put: Object new. 131 | Assert false: object == object shallowCopy. 132 | Assert true: object = object shallowCopy. 133 | Assert true: (object at: 1) == (object shallowCopy at: 1). 134 | Assert false: (object at: 1) == (object deepCopy at: 1). 135 | ] 136 | -------------------------------------------------------------------------------- /tests/OrderedCollectionTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | | collection expected | 3 | 4 | collection := OrderedCollection new. 5 | collection add: 1; add: 2; add: 3. 6 | Assert true: (collection removeIndex: 2) = 2. 7 | Assert true: collection = (OrderedCollection new add: 1; add: 3; yourself). 8 | 9 | collection := OrderedCollection new. 10 | collection add: 1; add: 2; add: 3. 11 | Assert true: (collection removeIndex: 1) = 1. 12 | Assert true: collection = (OrderedCollection new add: 2; add: 3; yourself). 13 | 14 | collection := OrderedCollection new. 15 | collection add: 1; add: 2; add: 3. 16 | Assert true: (collection removeIndex: 3) = 3. 17 | Assert true: collection = (OrderedCollection new add: 1; add: 2; yourself). 18 | 19 | collection := OrderedCollection new. 20 | collection add: 1; add: 2; add: 3; add: 4; add: 5; add: 6. 21 | 22 | expected := OrderedCollection new. 23 | expected add: 1; add: 2; add: 7; add: 3; add: 4; add: 5; add: 6. 24 | collection add: 7 beforeIndex: 3. 25 | Assert true: collection = expected. 26 | 27 | expected := OrderedCollection new. 28 | expected add: 1; add: 2; add: 7; add: 3; add: 8; add: 4; add: 5; add: 6. 29 | collection add: 8 afterIndex: 4. 30 | Assert true: collection = expected. 31 | 32 | Assert do: [OrderedCollection new last] expect: Error. 33 | ] 34 | 35 | [ 36 | Assert true: (OrderedCollection new add: 1; add: 2; add: 3; yourself) asArray = #(1 2 3). 37 | ] 38 | -------------------------------------------------------------------------------- /tests/OuterReturnTest.st: -------------------------------------------------------------------------------- 1 | OuterReturnTest := Object [ 2 | 3 | class createBlock [ 4 | ^[^1] 5 | ] 6 | 7 | 8 | class outerReturn [ 9 | [^1]. 10 | [[^4] value. ^2] value. 11 | ^3 12 | ] 13 | 14 | class outerReturn2 [ 15 | true ifTrue: [^1]. 16 | ^2 17 | ] 18 | 19 | class outerReturn3 [ 20 | true ifFalse: [^1]. 21 | ^2 22 | ] 23 | ] 24 | 25 | 26 | [ 27 | Assert do: [OuterReturnTest createBlock value] expect: Error. 28 | Assert true: OuterReturnTest outerReturn = 4. 29 | Assert true: OuterReturnTest outerReturn2 = 1. 30 | Assert true: OuterReturnTest outerReturn3 = 2. 31 | ] 32 | -------------------------------------------------------------------------------- /tests/ParserTest.st: -------------------------------------------------------------------------------- 1 | MockNodeVisitor := Object [ 2 | 3 | visitClassNode: aNode [ 4 | Assert true: (aNode isKindOf: ClassNode). 5 | ] 6 | 7 | 8 | visitVariableNode: aNode [ 9 | Assert true: (aNode isKindOf: VariableNode). 10 | ] 11 | 12 | 13 | visitMethodNode: aNode [ 14 | Assert true: (aNode isKindOf: MethodNode). 15 | ] 16 | 17 | 18 | visitBlockNode: aNode [ 19 | Assert true: (aNode isKindOf: BlockNode). 20 | ] 21 | 22 | 23 | visitExpressionNode: aNode [ 24 | Assert true: (aNode isKindOf: ExpressionNode). 25 | ] 26 | 27 | 28 | visitIntegerNode: aNode [ 29 | Assert true: (aNode isKindOf: IntegerNode). 30 | ] 31 | 32 | 33 | visitMessageExpressionNode: aNode [ 34 | Assert true: (aNode isKindOf: MessageExpressionNode). 35 | ] 36 | 37 | 38 | visitArrayNode: aNode [ 39 | Assert true: (aNode isKindOf: ArrayNode). 40 | ] 41 | 42 | 43 | visitCharacterNode: aNode [ 44 | Assert true: (aNode isKindOf: CharacterNode). 45 | ] 46 | 47 | 48 | visitFalseNode: aNode [ 49 | Assert true: (aNode isKindOf: FalseNode). 50 | ] 51 | 52 | 53 | visitTrueNode: aNode [ 54 | Assert true: (aNode isKindOf: TrueNode). 55 | ] 56 | 57 | 58 | visitNilNode: aNode [ 59 | Assert true: (aNode isKindOf: NilNode). 60 | ] 61 | 62 | ] 63 | 64 | 65 | [ "test valid smalltalk code" 66 | | parser | 67 | 68 | parser := Parser parseString: 'Foo := Object []'. 69 | Assert true: (parser parseClass isKindOf: ClassNode). 70 | parser := Parser parseString: 'foo []'. 71 | Assert true: (parser parseMethod isKindOf: MethodNode). 72 | parser := Parser parseString: 'foo []'. 73 | Assert true: (parser parseMethodOrBlock isKindOf: MethodNode). 74 | parser := Parser parseString: '[]'. 75 | Assert true: (parser parseMethodOrBlock isKindOf: BlockNode). 76 | ] 77 | 78 | [ "test empty input" 79 | | parser | 80 | 81 | parser := Parser parseString: ''. 82 | Assert do: [parser parseClass] expect: ParseError. 83 | parser := Parser parseString: ''. 84 | Assert do: [parser parseMethod] expect: ParseError. 85 | parser := Parser parseString: ''. 86 | Assert do: [parser parseMethodOrBlock] expect: ParseError. 87 | ] 88 | 89 | [ "test invalid smalltalk code" 90 | | parser | 91 | 92 | parser := Parser parseString: 'a'. 93 | Assert do: [parser parseClass] expect: ParseError. 94 | parser := Parser parseString: 'Object subclass'. 95 | Assert do: [parser parseClass] expect: ParseError. 96 | parser := Parser parseString: 'Object subclass: Foo'. 97 | Assert do: [parser parseClass] expect: ParseError. 98 | parser := Parser parseString: 'Object subclass: $'. 99 | Assert do: [parser parseClass] expect: ParseError. 100 | 101 | parser := Parser parseString: 'a'. 102 | Assert do: [parser parseMethod] expect: ParseError. 103 | parser := Parser parseString: 'a ['. 104 | Assert do: [parser parseMethod] expect: ParseError. 105 | parser := Parser parseString: 'a: ['. 106 | Assert do: [parser parseMethod] expect: ParseError. 107 | parser := Parser parseString: '+ 1 ['. 108 | Assert do: [parser parseMethod] expect: ParseError. 109 | 110 | parser := Parser parseString: 'a'. 111 | Assert do: [parser parseMethodOrBlock] expect: ParseError. 112 | parser := Parser parseString: 'a ['. 113 | Assert do: [parser parseMethodOrBlock] expect: ParseError. 114 | parser := Parser parseString: 'a: ['. 115 | Assert do: [parser parseMethodOrBlock] expect: ParseError. 116 | parser := Parser parseString: '[x:]'. 117 | Assert do: [parser parseMethodOrBlock] expect: ParseError. 118 | ] 119 | 120 | [ "extra long method selector" 121 | | stream method | 122 | 123 | stream := CollectionStream with: (String new: 512). 124 | stream next: 256 put: $a; nextPutAll: '[]'. 125 | 126 | method := (Parser parseString: stream contents) parseMethod. 127 | Assert true: method selector size = 256. 128 | Assert true: (method selector at: 1) = $a. 129 | Assert true: (method selector at: 256) = $a. 130 | ] 131 | 132 | [ "visitor test" 133 | | parser | 134 | 135 | parser := Parser parseString: 'Foo := Object [ bar: a [ | b | b := 1 + 2. #(1 $a). false. true. nil ] ]'. 136 | parser parseClass acceptVisitor: MockNodeVisitor new. 137 | ] 138 | -------------------------------------------------------------------------------- /tests/RegAllocTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | | a b c d e f g h i j | 3 | 4 | a := 1. 5 | b := 2. 6 | c := 3. 7 | d := 4. 8 | e := 5. 9 | f := 6. 10 | g := 7. 11 | h := 8. 12 | i := 9. 13 | j := 10. 14 | 15 | a + b + c + d + e + f + g + h + i + j. 16 | 17 | a := b. 18 | a := c. 19 | a := d. 20 | a := e. 21 | a := f. 22 | a := g. 23 | a := h. 24 | a := i. 25 | a := j. 26 | 27 | b := a. 28 | b := c. 29 | b := d. 30 | b := e. 31 | b := f. 32 | b := g. 33 | b := h. 34 | b := i. 35 | b := j. 36 | 37 | c := a. 38 | c := b. 39 | c := d. 40 | c := e. 41 | c := f. 42 | c := g. 43 | c := h. 44 | c := i. 45 | c := j. 46 | 47 | d := a. 48 | d := b. 49 | d := c. 50 | d := e. 51 | d := f. 52 | d := g. 53 | d := h. 54 | d := i. 55 | d := j. 56 | 57 | d := a. 58 | d := b. 59 | d := c. 60 | d := e. 61 | d := f. 62 | d := g. 63 | d := h. 64 | d := i. 65 | d := j. 66 | 67 | j := a. 68 | j := b. 69 | j := c. 70 | j := d. 71 | j := e. 72 | j := f. 73 | j := g. 74 | j := h. 75 | j := i. 76 | 77 | a + b + c + d + e + f + g + h + i + j. 78 | ] 79 | -------------------------------------------------------------------------------- /tests/SmallIntegerTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | Assert do: [6 < Object] expect: Error. 3 | Assert do: [6 + Object] expect: Error. 4 | Assert do: [6 - Object] expect: Error. 5 | Assert do: [6 * Object] expect: Error. 6 | Assert do: [6 // Object] expect: Error. 7 | Assert do: [6 \\ Object] expect: Error. 8 | Assert do: [6 / Object] expect: Error. 9 | Assert do: [6 quo: Object] expect: Error. 10 | Assert do: [6 rem: Object] expect: Error. 11 | Assert do: [6 bitAnd: Object] expect: Error. 12 | Assert do: [6 bitOr: Object] expect: Error. 13 | Assert do: [6 bitXor: Object] expect: Error. 14 | Assert do: [6 bitShift: Object] expect: Error. 15 | ] 16 | -------------------------------------------------------------------------------- /tests/StreamViewTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | | stream view | 3 | 4 | stream := CollectionStream on: 'abcdef'. 5 | view := StreamView on: stream limit: 3. 6 | 7 | Assert true: view peek = $a. 8 | Assert true: view next = $a. 9 | Assert true: (view next: 2) = 'bc'. 10 | Assert do: [view next] expect: Error. 11 | Assert do: [view next: 2] expect: Error. 12 | Assert true: view peek = nil. 13 | 14 | stream := CollectionStream on: 'abcdef'. 15 | view := StreamView on: stream limit: 3. 16 | Assert true: view contents = 'abc'. 17 | 18 | stream := CollectionStream on: 'abcdef'. 19 | view := StreamView on: stream limit: 3. 20 | view position: 2. 21 | Assert true: view next = $b. 22 | view position: 3. 23 | Assert do: [view position: 4] expect: Error. 24 | 25 | "stream := CollectionStream on: 'abcdef'. 26 | view := StreamView on: stream limit: 3. 27 | view next: 2. 28 | view reset. 29 | Assert true: view next = $a." 30 | 31 | stream := CollectionStream on: 'abcdef'. 32 | view := StreamView on: stream limit: 3. 33 | view skip: 2. 34 | Assert true: view next = $c. 35 | view skip: -3. 36 | Assert true: view next = $a. 37 | ] 38 | -------------------------------------------------------------------------------- /tests/StringTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | Assert true: 3 | (' abc gh i ' splitBy: Character space) = (OrderedCollection with: 'abc' with: 'gh' with: 'i'). 4 | Assert true: 5 | ('2abc1gh3i1' splitByAll: #($1 $2 $3)) = (OrderedCollection with: 'abc' with: 'gh' with: 'i'). 6 | ] 7 | -------------------------------------------------------------------------------- /tests/UndefinedObjectTest.st: -------------------------------------------------------------------------------- 1 | [ 2 | Assert true: nil isNil. 3 | Assert true: nil == nil copy. 4 | ] 5 | -------------------------------------------------------------------------------- /vm/Assert.h: -------------------------------------------------------------------------------- 1 | #ifndef ASSERT_H 2 | #define ASSERT_H 3 | 4 | #include 5 | #include 6 | 7 | #ifdef NDEBUG 8 | #define ASSERT(cond) while(0 && (cond)) {} 9 | #define FAIL() { \ 10 | printf("Fatal error\n"); \ 11 | exit(EXIT_FAILURE); \ 12 | } 13 | #else 14 | #define ASSERT(cond) \ 15 | if (!(cond)) { \ 16 | printf("Assertion '%s' failed in %s:%u\n", #cond, __FILE__, __LINE__); \ 17 | abort(); \ 18 | } 19 | #define FAIL() { \ 20 | printf("Fatal error\n"); \ 21 | abort(); \ 22 | } 23 | #endif 24 | 25 | #endif 26 | -------------------------------------------------------------------------------- /vm/Bootstrap.h: -------------------------------------------------------------------------------- 1 | #ifndef BOOTSTRAP_H 2 | #define BOOTSTRAP_H 3 | 4 | _Bool bootstrap(char *kernelDir); 5 | 6 | #endif 7 | -------------------------------------------------------------------------------- /vm/Cli.h: -------------------------------------------------------------------------------- 1 | #ifndef CLI_H 2 | #define CLI_H 3 | 4 | #include 5 | 6 | typedef struct { 7 | char *error; 8 | char operand; 9 | char *bootstrapDir; 10 | char *snapshotFileName; 11 | char *fileName; 12 | char *eval; 13 | _Bool printHelp; 14 | } CliArgs; 15 | 16 | 17 | static void parseCliArgs(CliArgs *cliArgs, int argc, char **args) 18 | { 19 | cliArgs->error = NULL; 20 | cliArgs->operand = '0'; 21 | cliArgs->bootstrapDir = NULL; 22 | cliArgs->snapshotFileName = "snapshot"; 23 | cliArgs->fileName = NULL; 24 | cliArgs->eval = NULL; 25 | cliArgs->printHelp = 0; 26 | 27 | int arg; 28 | opterr = 0; 29 | while ((arg = getopt(argc, args, "hb:s:f:e:")) != -1) { 30 | switch (arg) { 31 | case 'e': 32 | cliArgs->eval = optarg; 33 | break; 34 | case 'f': 35 | cliArgs->fileName = optarg; 36 | break; 37 | case 's': 38 | cliArgs->snapshotFileName = optarg; 39 | break; 40 | case 'b': 41 | cliArgs->bootstrapDir = optarg; 42 | break; 43 | case 'h': 44 | cliArgs->printHelp = 1; 45 | break; 46 | case '?': 47 | cliArgs->operand = optopt; 48 | switch (optopt) { 49 | case 'e': 50 | case 'f': 51 | case 's': 52 | case 'b': 53 | cliArgs->error = "Option -%c requires an operand"; 54 | break; 55 | default: 56 | cliArgs->error = "Unrecognized option: '-%c'"; 57 | cliArgs->operand = optopt; 58 | break; 59 | } 60 | break; 61 | } 62 | } 63 | opterr = 1; 64 | 65 | if (cliArgs->eval != NULL && cliArgs->fileName != NULL) { 66 | cliArgs->error = "Cannot use -e and -f together"; 67 | } 68 | } 69 | 70 | 71 | static void printCliHelp(void) 72 | { 73 | printf( 74 | "Usage:\t [-e ] [-f ] [-s ] [-b ]\n" 75 | "\t-e evaluate code\n" 76 | "\t-f compile classes and evaluate code within specified file\n" 77 | "\t-s path to snapshot file\n" 78 | "\t-b bootstrap from kernel directory\n" 79 | "\t-h prints this help\n" 80 | ); 81 | } 82 | 83 | #endif 84 | -------------------------------------------------------------------------------- /vm/CodeGenerator.h: -------------------------------------------------------------------------------- 1 | #ifndef CODE_GENERATOR_H 2 | #define CODE_GENERATOR_H 3 | 4 | #include "Object.h" 5 | #include "CompiledCode.h" 6 | #include "Assembler.h" 7 | #include "AssemblerX64.h" 8 | #include "Lookup.h" 9 | #include "String.h" 10 | #include "RegisterAllocator.h" 11 | 12 | typedef struct { 13 | CompiledCode code; 14 | AssemblerBuffer buffer; 15 | size_t frameSize; 16 | size_t frameRawAreaSize; 17 | RegsAlloc regsAlloc; 18 | uint8_t tmpVar; 19 | ptrdiff_t bytecodeNumber; 20 | OrderedCollection *stackmaps; 21 | OrderedCollection *descriptors; 22 | } CodeGenerator; 23 | 24 | NativeCode *generateMethodCode(CompiledMethod *method); 25 | void generateLoadObject(AssemblerBuffer *buffer, RawObject *object, Register dst, _Bool tag); 26 | void generateLoadClass(AssemblerBuffer *buffer, Register src, Register dst); 27 | void generateStoreCheck(CodeGenerator *generator, Register object, Register value); 28 | void generateMethodLookup(CodeGenerator *generator); 29 | void generateStackmap(CodeGenerator *generator); 30 | void generateCCall(CodeGenerator *generator, intptr_t cFunction, size_t argsSize, _Bool storeIp); 31 | void generateMethodContextAllocation(CodeGenerator *generator, size_t size); 32 | void generateBlockContextAllocation(CodeGenerator *generator); 33 | void generatePushDummyContext(AssemblerBuffer *buffer); 34 | NativeCode *generateDoesNotUnderstand(String *selector); 35 | NativeCode *buildNativeCode(CodeGenerator *generator); 36 | NativeCode *buildNativeCodeFromAssembler(AssemblerBuffer *buffer); 37 | 38 | #endif 39 | -------------------------------------------------------------------------------- /vm/Collection.h: -------------------------------------------------------------------------------- 1 | #ifndef COLLECTION_H 2 | #define COLLECTION_H 3 | 4 | #include "Object.h" 5 | 6 | typedef struct { 7 | OBJECT_HEADER; 8 | Value contents; 9 | Value firstIndex; 10 | Value lastIndex; 11 | } RawOrderedCollection; 12 | OBJECT_HANDLE(OrderedCollection); 13 | 14 | Array *newArray(size_t size); 15 | Object *arrayObjectAt(Array *array, ptrdiff_t index); 16 | void arrayAtPutObject(Array *array, ptrdiff_t index, Object *object); 17 | OrderedCollection *arrayAsOrdColl(Array *array); 18 | OrderedCollection *newOrdColl(size_t size); 19 | size_t ordCollSize(OrderedCollection *collection); 20 | void ordCollAdd(OrderedCollection *collection, Value value); 21 | void ordCollAddObject(OrderedCollection *collection, Object *object); 22 | ptrdiff_t ordCollAddObjectIfNotExists(OrderedCollection *collection, Object *object); 23 | void ordCollRemoveLast(OrderedCollection *collection); 24 | Value ordCollAt(OrderedCollection *collection, ptrdiff_t index); 25 | Object *ordCollObjectAt(OrderedCollection *collection, Value index); 26 | RawArray *ordCollGetContents(OrderedCollection *collection); 27 | intptr_t ordCollGetFirstIndex(OrderedCollection *collection); 28 | intptr_t ordCollGetLastIndex(OrderedCollection *collection); 29 | Array *ordCollAsArray(OrderedCollection *collection); 30 | 31 | #endif 32 | -------------------------------------------------------------------------------- /vm/CompiledCode.c: -------------------------------------------------------------------------------- 1 | #include "CompiledCode.h" 2 | #include "Thread.h" 3 | #include "Smalltalk.h" 4 | #include "Class.h" 5 | #include "Heap.h" 6 | #include "HeapPage.h" 7 | #include "Handle.h" 8 | #include "Iterator.h" 9 | #include "Assert.h" 10 | 11 | 12 | NativeCode *findNativeCodeAtIc(uint8_t *ic) 13 | { 14 | PageSpaceIterator iterator; 15 | NativeCode *obj; 16 | pageSpaceIteratorInit(&iterator, &CurrentThread.heap.execSpace); 17 | obj = (NativeCode *) pageSpaceIteratorNext(&iterator); 18 | while (obj != NULL) { 19 | if ((obj->tags & TAG_FREESPACE) == 0 && obj->insts <= ic && ic < obj->insts + obj->size) { 20 | return obj; 21 | } 22 | obj = (NativeCode *) pageSpaceIteratorNext(&iterator); 23 | } 24 | return NULL; 25 | } 26 | 27 | 28 | void printMethodsUsage(void) 29 | { 30 | PageSpaceIterator iterator; 31 | pageSpaceIteratorInit(&iterator, &CurrentThread.heap.execSpace); 32 | NativeCode *code = (NativeCode *) pageSpaceIteratorNext(&iterator); 33 | 34 | while (code != NULL) { 35 | if ((code->tags & TAG_FREESPACE) == 0) { 36 | if (code->compiledCode != NULL) { 37 | RawCompiledMethod *method = (RawCompiledMethod *) code->compiledCode; 38 | _Bool isBlock = method->class == Handles.CompiledBlock->raw; 39 | if (isBlock) { 40 | method = (RawCompiledMethod *) asObject(((RawCompiledBlock *) method)->method); 41 | } 42 | RawString *selector = (RawString *) asObject(method->selector); 43 | RawClass *class = (RawClass *) asObject(method->ownerClass); 44 | printClassName(class); 45 | printf( 46 | "#%.*s%s\t", 47 | (int) selector->size, selector->contents, 48 | isBlock ? "[]" : "" 49 | ); 50 | } else { 51 | printf("\t"); 52 | } 53 | printf("%zu\n", code->counter); 54 | } 55 | code = (NativeCode *) pageSpaceIteratorNext(&iterator); 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /vm/Compiler.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPILER_H 2 | #define COMPILER_H 3 | 4 | #include "Object.h" 5 | #include "CompiledCode.h" 6 | #include "Parser.h" 7 | 8 | enum { 9 | CONTEXT_INDEX = 0, 10 | SELF_INDEX = 1, 11 | SUPER_INDEX = 1, 12 | }; 13 | 14 | typedef struct { 15 | OBJECT_HEADER; 16 | Value messageText; 17 | Value variable; 18 | } RawCompileError; 19 | OBJECT_HANDLE(CompileError); 20 | 21 | Object *compileMethod(MethodNode *node, Class *class); 22 | CompileError *createUndefinedVariableError(LiteralNode *node); 23 | CompileError *createRedefinitionError(LiteralNode *var); 24 | void compileErrorSetVariable(CompileError *error, LiteralNode *node); 25 | LiteralNode *compileErrorGetVariable(CompileError *error); 26 | _Bool isCompileError(Object *object); 27 | void printCompileError(CompileError *error); 28 | 29 | #endif 30 | -------------------------------------------------------------------------------- /vm/Dictionary.h: -------------------------------------------------------------------------------- 1 | #ifndef DICTIONARY_H 2 | #define DICTIONARY_H 3 | 4 | #include "Object.h" 5 | #include "Collection.h" 6 | #include "String.h" 7 | 8 | typedef struct { 9 | OBJECT_HEADER; 10 | Value contents; 11 | Value tally; 12 | } RawDictionary; 13 | OBJECT_HANDLE(Dictionary); 14 | 15 | typedef _Bool (*DictComparator)(Value, Value); 16 | 17 | Dictionary *newDictionary(size_t size); 18 | Array *dictGetContents(Dictionary *dict); 19 | size_t dictSize(Dictionary *dict); 20 | 21 | Association *dictAtPut(Dictionary *dict, DictComparator cmp, Object *key, Value hash, Value value); 22 | Association *dictAtPutObject(Dictionary *dict, DictComparator cmp, Object *key, Value hash, Object *value); 23 | Value dictAt(Dictionary *dict, DictComparator cmp, Value key, Value hash); 24 | Association *dictAssocAt(Dictionary *dict, DictComparator cmp, Value key, Value hash); 25 | 26 | Association *symbolDictAtPut(Dictionary *dictionary, String *key, Value value); 27 | Association *symbolDictAtPutObject(Dictionary *dictionary, String *key, Object *object); 28 | Value symbolDictAt(Dictionary *dictionary, String *key); 29 | Object *symbolDictObjectAt(Dictionary *dictionary, String *key); 30 | Association *symbolDictAssocAt(Dictionary *dictionary, String *key); 31 | 32 | Association *stringDictAtPut(Dictionary *dictionary, String *key, Value value); 33 | Association *stringDictAtPutObject(Dictionary *dictionary, String *key, Object *object); 34 | Value stringDictAt(Dictionary *dictionary, String *key); 35 | Object *stringDictObjectAt(Dictionary *dictionary, String *key); 36 | Association *stringDictAssocAt(Dictionary *dictionary, String *key); 37 | 38 | #endif 39 | -------------------------------------------------------------------------------- /vm/Entry.h: -------------------------------------------------------------------------------- 1 | #ifndef ENTRY_H 2 | #define ENTRY_H 3 | 4 | #include "Object.h" 5 | #include "CompiledCode.h" 6 | #include "String.h" 7 | 8 | #define ENTRY_MAX_ARGS_SIZE 16 9 | 10 | typedef struct { 11 | _Bool isHandle; 12 | union { Value value; Object *handle; }; 13 | } EntryArg; 14 | 15 | typedef struct { 16 | size_t size; 17 | EntryArg values[ENTRY_MAX_ARGS_SIZE]; 18 | } EntryArgs; 19 | 20 | Value invokeMethod(CompiledMethod *method, EntryArgs *args); 21 | Value invokeInititalize(Object *object); 22 | Value sendMessage(String *selector, EntryArgs *args); 23 | Value evalCode(char *source); 24 | _Bool parseFileAndInitialize(char *filename, Value *lastBlockResult); 25 | _Bool parseFile(char *filename, OrderedCollection *classes, OrderedCollection *blocks); 26 | 27 | 28 | static void entryArgsAddObject(EntryArgs *args, Object *object) 29 | { 30 | intptr_t index = args->size++; 31 | ASSERT(index <= ENTRY_MAX_ARGS_SIZE); 32 | args->values[index].isHandle = 1; 33 | args->values[index].handle = object; 34 | } 35 | 36 | 37 | static void entryArgsAdd(EntryArgs *args, Value value) 38 | { 39 | intptr_t index = args->size++; 40 | ASSERT(index <= ENTRY_MAX_ARGS_SIZE); 41 | args->values[index].isHandle = 0; 42 | args->values[index].value = value; 43 | } 44 | 45 | #endif 46 | -------------------------------------------------------------------------------- /vm/Exception.c: -------------------------------------------------------------------------------- 1 | #include "Exception.h" 2 | #include "Smalltalk.h" 3 | #include "Class.h" 4 | #include "Entry.h" 5 | #include "Handle.h" 6 | #include "StackFrame.h" 7 | 8 | /*__thread */Value CurrentExceptionHandler = 0; 9 | 10 | 11 | Value unwindExceptionHandler(RawObject *rawException) 12 | { 13 | if (CurrentExceptionHandler == 0) { 14 | return 0; 15 | } 16 | 17 | HandleScope scope; 18 | openHandleScope(&scope); 19 | 20 | Object *exception = scopeHandle(rawException); 21 | ExceptionHandler *handler = scopeHandle(asObject(CurrentExceptionHandler)); 22 | CurrentExceptionHandler = 0; 23 | 24 | do { 25 | RawContext *context = (RawContext *) asObject(handler->raw->context); 26 | if (contextHasValidFrame(context)) { 27 | Object *exceptionClass = scopeHandle(asObject(stackFrameGetArg(context->frame, 1))); 28 | EntryArgs args = { .size = 0 }; 29 | entryArgsAddObject(&args, exceptionClass); 30 | entryArgsAddObject(&args, exception); 31 | if (isTaggedTrue(sendMessage(Handles.handlesSymbol, &args))) { 32 | CurrentExceptionHandler = handler->raw->parent; 33 | closeHandleScope(&scope, NULL); 34 | return getTaggedPtr(handler); 35 | } 36 | } 37 | if (handler->raw->parent == 0) { 38 | closeHandleScope(&scope, NULL); 39 | return 0; 40 | } 41 | handler = scopeHandle(asObject(handler->raw->parent)); 42 | } while (1); 43 | 44 | closeHandleScope(&scope, NULL); 45 | return 0; 46 | } 47 | -------------------------------------------------------------------------------- /vm/Exception.h: -------------------------------------------------------------------------------- 1 | #ifndef EXCEPTION_H 2 | #define EXCEPTION_H 3 | 4 | #include "Object.h" 5 | 6 | typedef struct { 7 | OBJECT_HEADER; 8 | uint8_t *ip; 9 | Value parent; 10 | Value context; 11 | } RawExceptionHandler; 12 | OBJECT_HANDLE(ExceptionHandler); 13 | 14 | extern /*__thread */Value CurrentExceptionHandler; 15 | 16 | Value unwindExceptionHandler(RawObject *exception); 17 | 18 | #endif 19 | -------------------------------------------------------------------------------- /vm/FreeList.h: -------------------------------------------------------------------------------- 1 | #ifndef FREE_LIST_H 2 | #define FREE_LIST_H 3 | 4 | #include 5 | #include 6 | 7 | #define FREE_LIST_SIZE 128 8 | #define FREE_MAP_SIZE (FREE_LIST_SIZE / 8 + 1) 9 | #define FREE_LIST_COLLECT_STATS 0 10 | 11 | typedef struct FreeSpace { 12 | struct FreeSpace *next; 13 | uintptr_t size:56; 14 | uint8_t tags; 15 | } FreeSpace; 16 | 17 | typedef struct { 18 | FreeSpace *freeSpaces[FREE_LIST_SIZE + 1]; 19 | uint8_t freeMap[FREE_MAP_SIZE]; 20 | #if FREE_LIST_COLLECT_STATS 21 | struct { 22 | size_t exactAllocs; 23 | size_t nextAllocs; 24 | size_t fallbackAllocs; 25 | size_t averageSize; 26 | size_t addedFreeSpaces; 27 | size_t averageAddedSpaceSize; 28 | size_t expanded; 29 | } stats; 30 | #endif 31 | } FreeList; 32 | 33 | struct HeapPage; 34 | 35 | void initFreeList(FreeList *freeList, struct HeapPage *page); 36 | void expandFreeList(FreeList *freeList, struct HeapPage *page); 37 | FreeSpace *createFreeSpace(uint8_t *p, size_t size); 38 | void freeListAddFreeSpace(FreeList *freeList, FreeSpace *freeSpace); 39 | uint8_t *freeListTryAllocate(FreeList *freeList, size_t size); 40 | void freeListPrint(FreeList *freeList); 41 | 42 | #endif 43 | -------------------------------------------------------------------------------- /vm/GarbageCollector.h: -------------------------------------------------------------------------------- 1 | #ifndef GARBAGECOLLECTOR_H 2 | #define GARBAGECOLLECTOR_H 3 | 4 | #include "Object.h" 5 | #include "Thread.h" 6 | #include "HeapPage.h" 7 | 8 | typedef struct { 9 | size_t count; 10 | size_t total; 11 | size_t marked; 12 | size_t sweeped; 13 | size_t freed; 14 | size_t extended; 15 | int64_t time; 16 | int64_t totalTime; 17 | } GCStats; 18 | 19 | extern GCStats LastGCStats; 20 | 21 | void gcMarkRoots(Thread *thread); 22 | void gcSweep(PageSpace *space); 23 | void resetGcStats(void); 24 | void printGcStats(void); 25 | 26 | #endif 27 | -------------------------------------------------------------------------------- /vm/Handle.c: -------------------------------------------------------------------------------- 1 | #include "Handle.h" 2 | #include "Thread.h" 3 | #include "Heap.h" 4 | #include "Assert.h" 5 | #include 6 | 7 | SmalltalkHandles Handles = { NULL }; 8 | 9 | 10 | void freeHandle(void *handle) 11 | { 12 | Handle *p = (Handle *) handle; 13 | if (p->prev != NULL) { 14 | p->prev->next = p->next; 15 | } else { 16 | CurrentThread.handles = p->next; 17 | } 18 | free(handle); 19 | } 20 | 21 | 22 | void freeHandles(void) 23 | { 24 | Handle *p = CurrentThread.handles; 25 | CurrentThread.handles = NULL; 26 | while (p != NULL) { 27 | Handle *next = p->next; 28 | free(p); 29 | p = next; 30 | } 31 | } 32 | 33 | 34 | void *newObject(Class *class, size_t size) 35 | { 36 | return scopeHandle(allocateObject(&CurrentThread.heap, class->raw, size)); 37 | } 38 | 39 | 40 | Object *copyResizedObject(Object *object, size_t newSize) 41 | { 42 | Object *newObject = scopeHandle(allocateObject(&CurrentThread.heap, object->raw->class, newSize)); 43 | size_t size = objectSize(object); 44 | size = computeInstanceSize(object->raw->class->instanceShape, newSize > size ? size : newSize); 45 | size_t offset = HEADER_SIZE + object->raw->class->instanceShape.isIndexed * sizeof(Value); 46 | memcpy((uint8_t *) newObject->raw + offset, (uint8_t *) object->raw + offset, size - offset); 47 | return newObject; 48 | } 49 | 50 | 51 | void initHandlesIterator(HandlesIterator *iterator, Handle *handles) 52 | { 53 | iterator->current = handles; 54 | } 55 | 56 | 57 | _Bool handlesIteratorHasNext(HandlesIterator *iterator) 58 | { 59 | return iterator->current != NULL; 60 | } 61 | 62 | 63 | Object *handlesIteratorNext(HandlesIterator *iterator) 64 | { 65 | Handle *current = iterator->current; 66 | iterator->current = current->next; 67 | return (Object *) current; 68 | } 69 | 70 | 71 | void initHandleScopeIterator(HandleScopeIterator *iterator, HandleScope *scopes) 72 | { 73 | iterator->current = scopes; 74 | } 75 | 76 | 77 | _Bool handleScopeIteratorHasNext(HandleScopeIterator *iterator) 78 | { 79 | return iterator->current != NULL; 80 | } 81 | 82 | 83 | HandleScope *handleScopeIteratorNext(HandleScopeIterator *iterator) 84 | { 85 | HandleScope *current = iterator->current; 86 | iterator->current = current->parent; 87 | return current; 88 | } 89 | -------------------------------------------------------------------------------- /vm/Handle.h: -------------------------------------------------------------------------------- 1 | #ifndef HANDLE_H 2 | #define HANDLE_H 3 | 4 | #include "Object.h" 5 | #include "Thread.h" 6 | #include "Dictionary.h" 7 | #include 8 | 9 | #define REMEMBER_SCOPE_POSITION 0 10 | 11 | typedef struct Handle { 12 | void *object; 13 | struct Handle *prev; 14 | struct Handle *next; 15 | } Handle; 16 | 17 | typedef struct HandleScope { 18 | struct HandleScope *parent; 19 | Object handles[1024]; 20 | size_t size; 21 | #if REMEMBER_SCOPE_POSITION 22 | char *file; 23 | size_t line; 24 | #endif 25 | } HandleScope; 26 | 27 | typedef struct { 28 | Handle *current; 29 | } HandlesIterator; 30 | 31 | typedef struct { 32 | HandleScope *current; 33 | } HandleScopeIterator; 34 | 35 | typedef struct { 36 | Object *nil; 37 | Object *false; 38 | Object *true; 39 | Class *MetaClass; 40 | Class *UndefinedObject; 41 | Class *True; 42 | Class *False; 43 | Class *SmallInteger; 44 | Class *Symbol; 45 | Class *Character; 46 | //Class *Float; 47 | Class *String; 48 | Class *Array; 49 | Class *ByteArray; 50 | Class *Association; 51 | Class *Dictionary; 52 | Class *OrderedCollection; 53 | Class *Class; 54 | Class *TypeFeedback; 55 | Class *CompiledMethod; 56 | Class *CompiledBlock; 57 | Class *SourceCode; 58 | Class *FileSourceCode; 59 | Class *Block; 60 | Class *Message; 61 | Class *MethodContext; 62 | Class *BlockContext; 63 | Class *ExceptionHandler; 64 | Class *ClassNode; 65 | Class *MethodNode; 66 | Class *BlockNode; 67 | Class *BlockScope; 68 | Class *ExpressionNode; 69 | Class *MessageExpressionNode; 70 | Class *NilNode; 71 | Class *TrueNode; 72 | Class *FalseNode; 73 | Class *VariableNode; 74 | Class *IntegerNode; 75 | Class *CharacterNode; 76 | Class *SymbolNode; 77 | Class *StringNode; 78 | Class *ArrayNode; 79 | Class *ParseError; 80 | Class *UndefinedVariableError; 81 | Class *RedefinitionError; 82 | Class *ReadonlyVariableError; 83 | Class *InvalidPragmaError; 84 | Class *IoError; 85 | Dictionary *Smalltalk; 86 | Array *SymbolTable; 87 | String *initializeSymbol; 88 | String *finalizeSymbol; 89 | String *valueSymbol; 90 | String *value_Symbol; 91 | String *valueValueSymbol; 92 | String *doesNotUnderstandSymbol; 93 | String *cannotReturnSymbol; 94 | String *handlesSymbol; 95 | String *generateBacktraceSymbol; 96 | } SmalltalkHandles; 97 | 98 | extern SmalltalkHandles Handles; 99 | 100 | static void *scopeHandle(void *object); 101 | static void *closeHandleScope(HandleScope *scope, void *handle); 102 | 103 | static void *persistHandle(void *handle); 104 | static void *handle(void *object); 105 | void freeHandle(void *handle); 106 | void freeHandles(void); 107 | 108 | void *newObject(Class *class, size_t size); 109 | static Value getTaggedPtr(void *handle); 110 | Object *copyResizedObject(Object *object, size_t newSize); 111 | 112 | void initHandlesIterator(HandlesIterator *iterator, Handle *handles); 113 | _Bool handlesIteratorHasNext(HandlesIterator *iterator); 114 | Object *handlesIteratorNext(HandlesIterator *iterator); 115 | 116 | void initHandleScopeIterator(HandleScopeIterator *iterator, HandleScope *scopes); 117 | _Bool handleScopeIteratorHasNext(HandleScopeIterator *iterator); 118 | HandleScope *handleScopeIteratorNext(HandleScopeIterator *iterator); 119 | 120 | 121 | #if REMEMBER_SCOPE_POSITION 122 | #define openHandleScope(scope) _openHandleScope(scope, __FILE__, __LINE__) 123 | static void _openHandleScope(HandleScope *scope, char *file, size_t line) 124 | { 125 | memset(scope, 0, sizeof(*scope)); 126 | scope->parent = CurrentThread.handleScopes; 127 | scope->file = file; 128 | scope->line = line; 129 | CurrentThread.handleScopes = scope; 130 | } 131 | #else 132 | static void openHandleScope(HandleScope *scope) 133 | { 134 | memset(scope, 0, sizeof(*scope)); 135 | scope->parent = CurrentThread.handleScopes; 136 | CurrentThread.handleScopes = scope; 137 | } 138 | #endif 139 | 140 | 141 | static void *closeHandleScope(HandleScope *scope, void *handle) 142 | { 143 | ASSERT(CurrentThread.handleScopes == scope); 144 | CurrentThread.handleScopes = CurrentThread.handleScopes->parent; 145 | if (handle != NULL) { 146 | ASSERT(CurrentThread.handleScopes != NULL); 147 | return scopeHandle(((Object *) handle)->raw); 148 | } 149 | return NULL; 150 | } 151 | 152 | 153 | static void *scopeHandle(void *object) 154 | { 155 | ASSERT(CurrentThread.handleScopes != NULL); 156 | ASSERT(CurrentThread.handleScopes->size < 256); 157 | Object *handle = &CurrentThread.handleScopes->handles[CurrentThread.handleScopes->size++]; 158 | handle->raw = object; 159 | return handle; 160 | } 161 | 162 | 163 | static void *persistHandle(void *object) 164 | { 165 | return handle(((Object *) object)->raw); 166 | } 167 | 168 | 169 | static void *handle(void *object) 170 | { 171 | Handle *handle = malloc(sizeof(Handle)); 172 | ASSERT(handle != NULL); 173 | handle->object = object; 174 | handle->prev = NULL; 175 | handle->next = CurrentThread.handles; 176 | CurrentThread.handles = handle; 177 | return (void *) handle; 178 | } 179 | 180 | 181 | static Value getTaggedPtr(void *handle) 182 | { 183 | return tagPtr(((Object *) handle)->raw); 184 | } 185 | 186 | #endif 187 | -------------------------------------------------------------------------------- /vm/Heap.h: -------------------------------------------------------------------------------- 1 | #ifndef HEAP_H 2 | #define HEAP_H 3 | 4 | #include "Object.h" 5 | #include "HeapPage.h" 6 | #include "Scavenger.h" 7 | #include "RememberedSet.h" 8 | 9 | struct Thread; 10 | struct NativeCode; 11 | 12 | typedef struct Heap { 13 | struct Thread *thread; 14 | Scavenger newSpace; 15 | PageSpace oldSpace; 16 | PageSpace execSpace; 17 | RememberedSet rememberedSet; 18 | } Heap; 19 | 20 | void initHeap(Heap *heap, struct Thread *thread); 21 | void freeHeap(Heap *heap); 22 | RawObject *allocateObject(Heap *heap, RawClass *class, size_t size); 23 | void freeObject(PageSpace *space, RawObject *object); 24 | struct NativeCode *allocateNativeCode(Heap *heap, size_t size, size_t pointersOffsetsSize); 25 | uint8_t *allocate(Heap *heap, size_t size); 26 | uint8_t *tryAllocateOld(Heap *heap, size_t size, _Bool grow); 27 | void collectGarbage(struct Thread *thread); 28 | void markAndSweep(struct Thread *thread); 29 | void verifyHeap(Heap *heap); 30 | void printHeap(Heap *heap); 31 | 32 | #endif 33 | -------------------------------------------------------------------------------- /vm/HeapPage.c: -------------------------------------------------------------------------------- 1 | #include "HeapPage.h" 2 | #include "CompiledCode.h" 3 | #include "Assert.h" 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | #define PRINT_PAGE_ALLOC 0 10 | 11 | 12 | void initPageSpace(PageSpace *pageSpace, size_t size, _Bool executable) 13 | { 14 | HeapPage *page = mapHeapPage(size, executable); 15 | pageSpace->pages = pageSpace->pagesTail = page; 16 | initFreeList(&pageSpace->freeList, page); 17 | } 18 | 19 | 20 | void freePageSpace(PageSpace *pageSpace) 21 | { 22 | HeapPage *page = pageSpace->pages; 23 | while (page != NULL) { 24 | HeapPage *next = page->next; 25 | unmapHeapPage(page); 26 | page = next; 27 | } 28 | } 29 | 30 | 31 | HeapPage *mapHeapPage(size_t size, _Bool executable) 32 | { 33 | size_t alignedSize = align(size, getpagesize()); 34 | int protection = PROT_READ | PROT_WRITE | (executable ? PROT_EXEC : 0); 35 | HeapPage *page = mmap(NULL, alignedSize, protection, MAP_ANON | MAP_PRIVATE, -1, 0); 36 | 37 | if (page == MAP_FAILED) { 38 | FAIL(); 39 | } 40 | 41 | page->next = NULL; 42 | page->isExecutable = executable; 43 | page->size = alignedSize; 44 | page->bodySize = alignedSize - sizeof(*page); 45 | page->body = (uint8_t *) page + sizeof(*page); 46 | memset(page->body, executable ? 0xCC : 0, page->bodySize); 47 | page->bodySize -= page->bodySize % HEAP_OBJECT_ALIGN; 48 | #if PRINT_PAGE_ALLOC 49 | printf("Page %p %zu%s\n", page, size, executable ? " executable" : ""); 50 | #endif 51 | return page; 52 | } 53 | 54 | 55 | void unmapHeapPage(HeapPage *page) 56 | { 57 | if (munmap(page, page->size) == -1) { 58 | FAIL(); 59 | } 60 | } 61 | 62 | 63 | _Bool heapPageIncludes(HeapPage *page, uint8_t *addr) 64 | { 65 | return page->body <= addr && addr < page->body + page->bodySize; 66 | } 67 | 68 | 69 | uint8_t *pageSpaceTryAllocate(PageSpace *pageSpace, size_t size) 70 | { 71 | ASSERT(size % HEAP_OBJECT_ALIGN == 0); 72 | uint8_t *p = freeListTryAllocate(&pageSpace->freeList, size); 73 | ASSERT(p == NULL || pageSpaceIncludes(pageSpace, p)); 74 | return p; 75 | } 76 | 77 | 78 | HeapPage *pageSpaceFindPage(PageSpace *pageSpace, uint8_t *addr) 79 | { 80 | HeapPage *page = pageSpace->pages; 81 | 82 | while (page != NULL) { 83 | if (page->body <= addr && addr < page->body + page->bodySize) { 84 | return page; 85 | } 86 | page = page->next; 87 | } 88 | return NULL; 89 | } 90 | 91 | 92 | _Bool pageSpaceIncludes(PageSpace *PageSpace, uint8_t *addr) 93 | { 94 | HeapPage *page = PageSpace->pages; 95 | 96 | while (page != NULL) { 97 | if (page->body <= addr && addr < page->body + page->bodySize) { 98 | return 1; 99 | } 100 | page = page->next; 101 | } 102 | return 0; 103 | } 104 | 105 | 106 | void pageSpaceIteratorInit(PageSpaceIterator *iterator, PageSpace *space) 107 | { 108 | iterator->page = space->pages; 109 | iterator->current = (FreeSpace *) align((uintptr_t) iterator->page->body, HEAP_OBJECT_ALIGN); 110 | } 111 | 112 | 113 | RawObject *pageSpaceIteratorNext(PageSpaceIterator *iterator) 114 | { 115 | FreeSpace *object = iterator->current; 116 | if ((uint8_t *) object >= iterator->page->body + iterator->page->bodySize) { 117 | if (iterator->page->next == NULL) { 118 | return NULL; 119 | } 120 | iterator->page = iterator->page->next; 121 | object = (FreeSpace *) align((uintptr_t) iterator->page->body, HEAP_OBJECT_ALIGN); 122 | } 123 | 124 | size_t size; 125 | if (object->tags & TAG_FREESPACE) { 126 | size = object->size; 127 | } else if (iterator->page->isExecutable) { 128 | size = computeNativeCodeSize((NativeCode *) object); 129 | } else { 130 | size = computeRawObjectSize((RawObject *) object); 131 | } 132 | iterator->current = (FreeSpace *) ((uint8_t *) object + align(size, HEAP_OBJECT_ALIGN)); 133 | return (RawObject *) object; 134 | } 135 | -------------------------------------------------------------------------------- /vm/HeapPage.h: -------------------------------------------------------------------------------- 1 | #ifndef PAGE_H 2 | #define PAGE_H 3 | 4 | #include "Object.h" 5 | #include "FreeList.h" 6 | #include 7 | #include 8 | 9 | typedef struct HeapPage { 10 | struct HeapPage *next; 11 | _Bool isExecutable; 12 | size_t size; 13 | size_t bodySize; 14 | uint8_t *body; 15 | } HeapPage; 16 | 17 | typedef struct { 18 | HeapPage *pages; 19 | HeapPage *pagesTail; 20 | FreeList freeList; 21 | } PageSpace; 22 | 23 | typedef struct { 24 | HeapPage *page; 25 | FreeSpace *current; 26 | } PageSpaceIterator; 27 | 28 | void initPageSpace(PageSpace *pageSpace, size_t size, _Bool executable); 29 | void freePageSpace(PageSpace *pageSpace); 30 | HeapPage *mapHeapPage(size_t size, _Bool executable); 31 | void unmapHeapPage(HeapPage *page); 32 | _Bool heapPageIncludes(HeapPage *page, uint8_t *addr); 33 | uint8_t *pageSpaceTryAllocate(PageSpace *pageSpace, size_t size); 34 | HeapPage *pageSpaceFindPage(PageSpace *PageSpace, uint8_t *addr); 35 | _Bool pageSpaceIncludes(PageSpace *PageSpace, uint8_t *addr); 36 | void pageSpaceIteratorInit(PageSpaceIterator *iterator, PageSpace *space); 37 | RawObject *pageSpaceIteratorNext(PageSpaceIterator *iterator); 38 | 39 | 40 | static uintptr_t align(uintptr_t v, size_t align) 41 | { 42 | return (v + (align - 1)) & -align; 43 | } 44 | 45 | #endif 46 | -------------------------------------------------------------------------------- /vm/Iterator.c: -------------------------------------------------------------------------------- 1 | #include "Iterator.h" 2 | #include "Handle.h" 3 | #include "Assert.h" 4 | 5 | 6 | void initArrayIterator(Iterator *iterator, Array *array, ptrdiff_t from, ptrdiff_t to) 7 | { 8 | ASSERT(array->raw->class == Handles.Array->raw); 9 | iterator->start = array->raw->vars + from; 10 | iterator->end = array->raw->vars + array->raw->size + to; 11 | iterator->current = iterator->start; 12 | } 13 | 14 | 15 | void initOrdCollIterator(Iterator *iterator, OrderedCollection *ordColl, ptrdiff_t from, ptrdiff_t to) 16 | { 17 | ASSERT(ordColl->raw->class == Handles.OrderedCollection->raw); 18 | iterator->start = ordCollGetContents(ordColl)->vars + ordCollGetFirstIndex(ordColl) + from - 1; 19 | iterator->end = iterator->start + ordCollSize(ordColl) + to; 20 | iterator->current = iterator->start; 21 | } 22 | 23 | 24 | void initDictIterator(Iterator *iterator, Dictionary *dict) 25 | { 26 | ASSERT(dict->raw->class == Handles.Dictionary->raw); 27 | initArrayIterator(iterator, dictGetContents(dict), 0, 0); 28 | } 29 | 30 | 31 | ptrdiff_t iteratorIndex(Iterator *iterator) 32 | { 33 | return iterator->current - iterator->start; 34 | } 35 | 36 | 37 | _Bool iteratorHasNext(Iterator *iterator) 38 | { 39 | return iterator->current < iterator->end; 40 | } 41 | 42 | 43 | Value iteratorNext(Iterator *iterator) 44 | { 45 | return *iterator->current++; 46 | } 47 | 48 | 49 | Object *iteratorNextObject(Iterator *iterator) 50 | { 51 | return scopeHandle(asObject(iteratorNext(iterator))); 52 | } 53 | -------------------------------------------------------------------------------- /vm/Iterator.h: -------------------------------------------------------------------------------- 1 | #ifndef ITERATOR_H 2 | #define ITERATOR_H 3 | 4 | #include "Object.h" 5 | #include "Collection.h" 6 | #include "Dictionary.h" 7 | 8 | typedef struct { 9 | Value *start; 10 | Value *end; 11 | Value *current; 12 | } Iterator; 13 | 14 | void initArrayIterator(Iterator *iterator, Array *array, ptrdiff_t from, ptrdiff_t to); 15 | void initOrdCollIterator(Iterator *iterator, OrderedCollection *ordColl, ptrdiff_t from, ptrdiff_t to); 16 | void initDictIterator(Iterator *iterator, Dictionary *dict); 17 | ptrdiff_t iteratorIndex(Iterator *iterator); 18 | _Bool iteratorHasNext(Iterator *iterator); 19 | Value iteratorNext(Iterator *iterator); 20 | Object *iteratorNextObject(Iterator *iterator); 21 | 22 | #endif 23 | -------------------------------------------------------------------------------- /vm/Lookup.c: -------------------------------------------------------------------------------- 1 | #include "Lookup.h" 2 | #include "CodeGenerator.h" 3 | #include "Object.h" 4 | #include "Class.h" 5 | #include "String.h" 6 | #include "Smalltalk.h" 7 | #include "Heap.h" 8 | #include "Handle.h" 9 | #include "CompiledCode.h" 10 | #include "CodeDescriptors.h" 11 | #include "Thread.h" 12 | #include "StackFrame.h" 13 | 14 | LookupTable LookupCache = { 15 | .classes = { NULL }, 16 | .selectors = { NULL }, 17 | .codes = { NULL }, 18 | }; 19 | 20 | static void feedbackType(Class *class); 21 | static NativeCodeEntry doesNotUnderstand(Class *class, String *selector); 22 | 23 | 24 | NativeCodeEntry lookupNativeCode(RawClass *class, RawString *selector) 25 | { 26 | HandleScope scope; 27 | openHandleScope(&scope); 28 | 29 | Class *classHandle = scopeHandle(class); 30 | String *selectorHandle = scopeHandle(selector); 31 | CompiledMethod *method = lookupSelector(classHandle, selectorHandle); 32 | 33 | NativeCodeEntry entry; 34 | if (method == NULL) { 35 | entry = doesNotUnderstand(classHandle, selectorHandle); 36 | } else { 37 | entry = (NativeCodeEntry) getNativeCode(classHandle, method)->insts; 38 | feedbackType(classHandle); 39 | } 40 | 41 | intptr_t hash = lookupHash((intptr_t) classHandle->raw, (intptr_t) selectorHandle->raw); 42 | LookupCache.classes[hash] = classHandle->raw; 43 | LookupCache.selectors[hash] = selectorHandle->raw; 44 | LookupCache.codes[hash] = (uint8_t *) entry; 45 | 46 | closeHandleScope(&scope, NULL); 47 | return entry; 48 | } 49 | 50 | 51 | static void feedbackType(Class *class) 52 | { 53 | EntryStackFrame *entryFrame = CurrentThread.stackFramesTail; 54 | if (entryFrame == NULL) { 55 | return; 56 | } 57 | 58 | StackFrame *frame = stackFrameGetParent(entryFrame->exit, entryFrame); 59 | NativeCode *code = stackFrameGetNativeCode(frame); 60 | OrderedCollection *typeFeedback; 61 | if (code->typeFeedback == NULL) { 62 | typeFeedback = newOrdColl(8); 63 | code->typeFeedback = typeFeedback->raw; 64 | } else { 65 | typeFeedback = scopeHandle(code->typeFeedback); 66 | if (ordCollSize(typeFeedback) > 16) { 67 | typeFeedback = newOrdColl(8); 68 | code->typeFeedback = typeFeedback->raw; 69 | } 70 | } 71 | 72 | TypeFeedback *type = newObject(Handles.TypeFeedback, 0); 73 | type->raw->ic = tagInt(entryFrame->exit->parentIc - code->insts); 74 | type->raw->hintedClass = getTaggedPtr(class); 75 | ordCollAddObject(typeFeedback, (Object *) type); 76 | } 77 | 78 | 79 | static NativeCodeEntry doesNotUnderstand(Class *class, String *selector) 80 | { 81 | intptr_t hash = lookupHash((intptr_t) class->raw, (intptr_t) selector->raw); 82 | NativeCode *code = generateDoesNotUnderstand(selector); 83 | code->compiledCode = lookupSelector(class, Handles.doesNotUnderstandSymbol)->raw; 84 | return (NativeCodeEntry) code->insts; 85 | } 86 | 87 | 88 | NativeCode *getNativeCode(Class *class, CompiledMethod *method) 89 | { 90 | NativeCode *code = compiledMethodGetNativeCode(method); 91 | if (code == NULL) { 92 | String *selector = compiledMethodGetSelector(method); 93 | code = generateMethodCode(method); 94 | compiledMethodSetNativeCode(method, code); 95 | } 96 | return code; 97 | } 98 | -------------------------------------------------------------------------------- /vm/Lookup.h: -------------------------------------------------------------------------------- 1 | #ifndef MESSAGE_H 2 | #define MESSAGE_H 3 | 4 | #include "Object.h" 5 | #include "CompiledCode.h" 6 | #include "String.h" 7 | #include 8 | 9 | #define LOOKUP_CACHE_SIZE 4096 10 | 11 | typedef struct { 12 | OBJECT_HEADER; 13 | Value selector; 14 | Value arguments; 15 | } RawMessage; 16 | OBJECT_HANDLE(Message); 17 | 18 | typedef struct { 19 | RawClass *classes[LOOKUP_CACHE_SIZE]; 20 | RawString *selectors[LOOKUP_CACHE_SIZE]; 21 | uint8_t *codes[LOOKUP_CACHE_SIZE]; 22 | } LookupTable; 23 | 24 | extern LookupTable LookupCache; 25 | 26 | NativeCodeEntry lookupNativeCode(RawClass *class, RawString *selector); 27 | NativeCode *getNativeCode(Class *class, CompiledMethod *method); 28 | 29 | 30 | static intptr_t lookupHash(intptr_t classHash, intptr_t selectorHash) 31 | { 32 | return (classHash ^ selectorHash) & LOOKUP_CACHE_SIZE - 1; 33 | } 34 | 35 | 36 | static void flushLookupCache(void) 37 | { 38 | memset(&LookupCache, 0, sizeof(LookupCache.classes) + sizeof(LookupCache.selectors)); 39 | } 40 | 41 | 42 | static NativeCodeEntry cachedLookupNativeCode(RawClass *class, RawString *selector) 43 | { 44 | intptr_t hash = lookupHash((intptr_t) class, (intptr_t) selector); 45 | if (LookupCache.classes[hash] == class && LookupCache.selectors[hash] == selector) { 46 | return (NativeCodeEntry) LookupCache.codes[hash]; 47 | } 48 | return lookupNativeCode(class, selector); 49 | } 50 | 51 | #endif 52 | -------------------------------------------------------------------------------- /vm/Optimizer.h: -------------------------------------------------------------------------------- 1 | #ifndef OPTIMIZER_H 2 | #define OPTIMIZER_H 3 | 4 | #include "CompiledCode.h" 5 | 6 | CompiledMethod *optimizeMethod(CompiledMethod *method); 7 | 8 | #endif 9 | -------------------------------------------------------------------------------- /vm/Os.h: -------------------------------------------------------------------------------- 1 | #ifndef OS_H 2 | #define OS_H 3 | 4 | #include 5 | 6 | int64_t osCurrentMicroTime(void); 7 | 8 | #endif 9 | -------------------------------------------------------------------------------- /vm/OsLinux.c: -------------------------------------------------------------------------------- 1 | #include "Os.h" 2 | #include "Assert.h" 3 | #include 4 | #include 5 | 6 | 7 | int64_t osCurrentMicroTime(void) 8 | { 9 | struct timeval time; 10 | int result = gettimeofday(&time, NULL); 11 | if (result != 0) { 12 | FAIL(); 13 | } 14 | return time.tv_sec * 1000000 + time.tv_usec; 15 | } 16 | -------------------------------------------------------------------------------- /vm/Parser.h: -------------------------------------------------------------------------------- 1 | #ifndef PARSER_H 2 | #define PARSER_H 3 | 4 | #include "Tokenizer.h" 5 | #include "Object.h" 6 | #include "String.h" 7 | #include "Ast.h" 8 | #include 9 | 10 | typedef enum 11 | { 12 | PARSER_ERROR_NONE, 13 | PARSER_ERROR_UNEXPECTED_TOKEN, 14 | } ParserErrorCode; 15 | 16 | typedef struct 17 | { 18 | ParserErrorCode code; 19 | TokenType expected; 20 | } ParserError; 21 | 22 | typedef struct 23 | { 24 | Tokenizer tokenizer; 25 | String *sourceOrFileName; 26 | Class *sourceCodeClass; 27 | ParserError error; 28 | } Parser; 29 | 30 | typedef struct { 31 | OBJECT_HEADER; 32 | Value stream; 33 | Value source; 34 | Value atEnd; 35 | } RawParserObject; 36 | OBJECT_HANDLE(ParserObject); 37 | 38 | typedef struct { 39 | OBJECT_HEADER; 40 | Value messageText; 41 | Value token; 42 | Value sourceCode; 43 | } RawParseError; 44 | OBJECT_HANDLE(ParseError); 45 | 46 | void initParser(Parser *parser, String *source); 47 | void initFileParser(Parser *parser, FILE *file, String *fileName); 48 | void freeParser(Parser *parser); 49 | void printParseError(Parser *parser, char *filename); 50 | ClassNode *parseClass(Parser *parser); 51 | MethodNode *parseMethod(Parser *parser); 52 | BlockNode *parseBlock(Parser *parser); 53 | SourceCode *createSourceCode(Parser *parser, _Bool computeSize); 54 | _Bool parserAtEnd(Parser *parser); 55 | 56 | #endif 57 | -------------------------------------------------------------------------------- /vm/Primitives.h: -------------------------------------------------------------------------------- 1 | #ifndef PRIMITIVES_H 2 | #define PRIMITIVES_H 3 | 4 | #include "CodeGenerator.h" 5 | 6 | void registerPrimitives(void); 7 | void generatePrimitive(CodeGenerator *generator, uint16_t primitive); 8 | 9 | #endif 10 | -------------------------------------------------------------------------------- /vm/RegisterAllocator.h: -------------------------------------------------------------------------------- 1 | #ifndef REGISTER_ALLOCATOR_H 2 | #define REGISTER_ALLOCATOR_H 3 | 4 | #include "CompiledCode.h" 5 | #include "Bytecodes.h" 6 | #include "Assembler.h" 7 | 8 | #define SPILLED_REG -1 9 | 10 | typedef enum { 11 | VAR_CONTEXT = 0, 12 | VAR_CLASS = 1, 13 | VAR_ASSOC = 2, 14 | VAR_TMP = 3, 15 | } VariableType; 16 | 17 | typedef enum { 18 | VAR_DEFINED = 1, 19 | VAR_IN_REG = 1 << 1, 20 | VAR_ON_STACK = 1 << 2, 21 | } VariableFlags; 22 | 23 | typedef struct { 24 | uint8_t index; 25 | uint8_t type; 26 | VariableFlags flags; 27 | int8_t reg; 28 | size_t start; 29 | size_t end; 30 | ptrdiff_t frameOffset; 31 | } Variable; 32 | 33 | typedef struct { 34 | AvailableRegs *regs; 35 | uint8_t varsSize; 36 | Variable vars[256]; 37 | Variable *specialVars[3][256]; 38 | size_t frameSize; 39 | _Bool frameLess; 40 | } RegsAlloc; 41 | 42 | void computeRegsAlloc(RegsAlloc *alloc, AvailableRegs *regs, CompiledCode *code); 43 | void invalidateRegs(RegsAlloc *alloc); 44 | 45 | #endif 46 | -------------------------------------------------------------------------------- /vm/RememberedSet.h: -------------------------------------------------------------------------------- 1 | #ifndef REMEMBERED_SET 2 | #define REMEMBERED_SET 3 | 4 | #define REMEMBERED_SET_BLOCK_SIZE 1024 5 | 6 | typedef struct RememberedSetBlock { 7 | struct RememberedSetBlock *prev; 8 | Value *current; 9 | Value *end; 10 | Value objects[REMEMBERED_SET_BLOCK_SIZE]; 11 | } RememberedSetBlock; 12 | 13 | typedef struct { 14 | RememberedSetBlock *blocks; 15 | } RememberedSet; 16 | 17 | typedef struct { 18 | RememberedSetBlock *block; 19 | Value *blockEnd; 20 | RememberedSetBlock *firstBlock; 21 | _Bool hasPrevBlock; 22 | Value *next; 23 | } RememberedSetIterator; 24 | 25 | static void rememberedSetGrow(RememberedSet *rememberedSet); 26 | static RememberedSetBlock *createRememberedSetBlock(RememberedSetBlock *prev); 27 | static RememberedSetBlock *rememberedSetBlockFirst(RememberedSetBlock *block); 28 | static void rememberedSetIteratorSetBlock(RememberedSetIterator *iterator, RememberedSetBlock *block); 29 | 30 | 31 | static void initRememberedSet(RememberedSet *rememberedSet) 32 | { 33 | rememberedSet->blocks = createRememberedSetBlock(NULL); 34 | } 35 | 36 | 37 | static void rememberedSetAdd(RememberedSet *rememberedSet, RawObject *object) 38 | { 39 | RememberedSetBlock *block = rememberedSet->blocks; 40 | ASSERT(block->current < block->end); 41 | ASSERT((object->tags & TAG_REMEMBERED) == 0); 42 | object->tags |= TAG_REMEMBERED; 43 | *block->current++ = tagPtr(object); 44 | if (block->current == block->end) { 45 | rememberedSetGrow(rememberedSet); 46 | } 47 | } 48 | 49 | 50 | static void rememberedSetGrow(RememberedSet *rememberedSet) 51 | { 52 | rememberedSet->blocks = createRememberedSetBlock(rememberedSet->blocks); 53 | } 54 | 55 | 56 | static RememberedSetBlock *createRememberedSetBlock(RememberedSetBlock *prev) 57 | { 58 | RememberedSetBlock *block = malloc(sizeof(RememberedSetBlock)); 59 | ASSERT(block != NULL); 60 | block->prev = prev; 61 | block->current = block->objects; 62 | block->end = block->current + REMEMBERED_SET_BLOCK_SIZE; 63 | return block; 64 | } 65 | 66 | 67 | static void rememberedSetReset(RememberedSet *rememberedSet) 68 | { 69 | RememberedSetBlock *block = rememberedSet->blocks; 70 | RememberedSetBlock *prev = block->prev; 71 | while (prev != NULL) { 72 | RememberedSetBlock *tmp = prev; 73 | prev = tmp->prev; 74 | free(tmp); 75 | } 76 | 77 | block->prev = NULL; 78 | block->current = block->objects; 79 | } 80 | 81 | 82 | static void initRememberedSetIterator(RememberedSetIterator *iterator, RememberedSet *rememberedSet) 83 | { 84 | RememberedSetBlock *block = rememberedSet->blocks; 85 | iterator->firstBlock = rememberedSetBlockFirst(block); 86 | rememberedSetIteratorSetBlock(iterator, block); 87 | if (iterator->next == NULL && block != iterator->firstBlock) { 88 | rememberedSetIteratorSetBlock(iterator, block->prev); 89 | } 90 | } 91 | 92 | 93 | static RememberedSetBlock *rememberedSetBlockFirst(RememberedSetBlock *block) 94 | { 95 | while (block->prev != NULL) { 96 | block = block->prev; 97 | } 98 | return block; 99 | } 100 | 101 | 102 | static RawObject *rememberedSetIteratorNext(RememberedSetIterator *iterator) 103 | { 104 | Value *next = iterator->next; 105 | ASSERT(next != NULL); 106 | RawObject *object = asObject(*next++); 107 | if (next < iterator->blockEnd) { 108 | iterator->next = next; 109 | } else if (iterator->hasPrevBlock) { 110 | rememberedSetIteratorSetBlock(iterator, iterator->block->prev); 111 | } else { 112 | iterator->next = NULL; 113 | } 114 | return object; 115 | } 116 | 117 | 118 | static void rememberedSetIteratorSetBlock(RememberedSetIterator *iterator, RememberedSetBlock *block) 119 | { 120 | ASSERT(block != NULL); 121 | iterator->block = block; 122 | iterator->blockEnd = block->current; 123 | iterator->hasPrevBlock = block != iterator->firstBlock; 124 | iterator->next = block->objects < iterator->blockEnd ? block->objects : NULL; 125 | } 126 | 127 | 128 | static _Bool rememberedSetIteratorHasNext(RememberedSetIterator *iterator) 129 | { 130 | return iterator->next != NULL; 131 | } 132 | 133 | #endif 134 | -------------------------------------------------------------------------------- /vm/Repl.c: -------------------------------------------------------------------------------- 1 | #include "Repl.h" 2 | #include "Entry.h" 3 | #include "Handle.h" 4 | #include "Smalltalk.h" 5 | #include "Class.h" 6 | #include "Iterator.h" 7 | #include "../linenoise/linenoise.h" 8 | #include 9 | 10 | static void replAutocomplete(const char *buf, linenoiseCompletions *lc); 11 | 12 | 13 | void runRepl(void) 14 | { 15 | char *line; 16 | 17 | linenoiseSetCompletionCallback(replAutocomplete); 18 | linenoiseHistoryLoad("history.txt"); 19 | 20 | while ((line = linenoise("Smalltalk> ")) != NULL) { 21 | evalCode(line); 22 | linenoiseHistoryAdd(line); 23 | linenoiseHistorySave("history.txt"); 24 | free(line); 25 | } 26 | } 27 | 28 | 29 | static void replAutocomplete(const char *buf, linenoiseCompletions *lc) 30 | { 31 | HandleScope scope; 32 | openHandleScope(&scope); 33 | 34 | Class *repl = getClass("Repl"); 35 | String *str = asString((char *) buf); 36 | EntryArgs args = { .size = 0 }; 37 | entryArgsAddObject(&args, (Object *) repl); 38 | entryArgsAddObject(&args, (Object *) str); 39 | Value result = sendMessage(getSymbol("autocomplete:"), &args); 40 | 41 | if (getClassOf(result) != Handles.OrderedCollection->raw) { 42 | closeHandleScope(&scope, NULL); 43 | return; 44 | } 45 | 46 | Iterator iterator; 47 | initOrdCollIterator(&iterator, scopeHandle(asObject(result)), 0, 0); 48 | while (iteratorHasNext(&iterator)) { 49 | HandleScope scope2; 50 | openHandleScope(&scope2); 51 | linenoiseAddCompletion(lc, ((String *) iteratorNextObject(&iterator))->raw->contents); 52 | closeHandleScope(&scope2, NULL); 53 | } 54 | 55 | closeHandleScope(&scope, NULL); 56 | } 57 | -------------------------------------------------------------------------------- /vm/Repl.h: -------------------------------------------------------------------------------- 1 | #ifndef REPL_H 2 | #define REPL_H 3 | 4 | void runRepl(void); 5 | 6 | #endif 7 | -------------------------------------------------------------------------------- /vm/Scavenger.h: -------------------------------------------------------------------------------- 1 | #ifndef SCAVENGER_H 2 | #define SCAVENGER_H 3 | 4 | #include "HeapPage.h" 5 | 6 | struct Heap; 7 | 8 | typedef struct { 9 | struct Heap *heap; 10 | HeapPage *page; 11 | size_t size; 12 | _Bool hasPromotionFailure; 13 | uint8_t *fromSpace; 14 | uint8_t *toSpace; 15 | uint8_t *top; 16 | uint8_t *end; 17 | uint8_t *survivorEnd; 18 | } Scavenger; 19 | 20 | void initScavenger(Scavenger *scavenger, struct Heap *heap, size_t size); 21 | void freeScavenger(Scavenger *scavenger); 22 | uint8_t *scavengerTryAllocate(Scavenger *scavenger, size_t size); 23 | void scavengerScavenge(Scavenger *scavenger); 24 | _Bool scavengerIncludes(Scavenger *scavenger, uint8_t *addr); 25 | 26 | #endif 27 | -------------------------------------------------------------------------------- /vm/Scope.h: -------------------------------------------------------------------------------- 1 | #ifndef SCOPE_H 2 | #define SCOPE_H 3 | 4 | #include "Object.h" 5 | #include "Parser.h" 6 | #include "CompiledCode.h" 7 | #include "Compiler.h" 8 | 9 | typedef struct RawBlockScope { 10 | OBJECT_HEADER; 11 | CompiledCodeHeader header; 12 | Value parent; 13 | Value vars; 14 | Value ownerClass; 15 | Value literals; 16 | Value error; 17 | } RawBlockScope; 18 | OBJECT_HANDLE(BlockScope); 19 | 20 | BlockScope *analyzeMethod(MethodNode *node, Class *class); 21 | 22 | 23 | static void blockScopeSetHeader(BlockScope *blockScope, CompiledCodeHeader header) 24 | { 25 | blockScope->raw->header = header; 26 | } 27 | 28 | 29 | static CompiledCodeHeader blockScopeGetHeader(BlockScope *blockScope) 30 | { 31 | return blockScope->raw->header; 32 | } 33 | 34 | 35 | static void blockScopeSetParent(BlockScope *blockScope, BlockScope *parent) 36 | { 37 | objectStorePtr((Object *) blockScope, &blockScope->raw->parent, (Object *) parent); 38 | } 39 | 40 | 41 | static BlockScope *blockScopeGetParent(BlockScope *blockScope) 42 | { 43 | return scopeHandle(asObject(blockScope->raw->parent)); 44 | } 45 | 46 | 47 | static void blockScopeSetVars(BlockScope *blockScope, Dictionary *vars) 48 | { 49 | objectStorePtr((Object *) blockScope, &blockScope->raw->vars, (Object *) vars); 50 | } 51 | 52 | 53 | static Dictionary *blockScopeGetVars(BlockScope *blockScope) 54 | { 55 | return scopeHandle(asObject(blockScope->raw->vars)); 56 | } 57 | 58 | 59 | static void blockScopeSetOwnerClass(BlockScope *blockScope, Class *class) 60 | { 61 | objectStorePtr((Object *) blockScope, &blockScope->raw->ownerClass, (Object *) class); 62 | } 63 | 64 | 65 | static Class *blockScopeGetOwnerClass(BlockScope *blockScope) 66 | { 67 | return scopeHandle(asObject(blockScope->raw->ownerClass)); 68 | } 69 | 70 | 71 | static void blockScopeSetLiterals(BlockScope *blockScope, OrderedCollection *literals) 72 | { 73 | objectStorePtr((Object *) blockScope, &blockScope->raw->literals, (Object *) literals); 74 | } 75 | 76 | 77 | static OrderedCollection *blockScopeGetLiterals(BlockScope *blockScope) 78 | { 79 | return scopeHandle(asObject(blockScope->raw->literals)); 80 | } 81 | 82 | 83 | static void blockScopeSetError(BlockScope *blockScope, CompileError *error) 84 | { 85 | objectStorePtr((Object *) blockScope, &blockScope->raw->error, (Object *) error); 86 | } 87 | 88 | 89 | static CompileError *blockScopeGetError(BlockScope *blockScope) 90 | { 91 | return scopeHandle(asObject(blockScope->raw->error)); 92 | } 93 | 94 | 95 | static _Bool blockScopeHasError(BlockScope *blockScope) 96 | { 97 | return !isTaggedNil(blockScope->raw->error); 98 | } 99 | 100 | #endif 101 | -------------------------------------------------------------------------------- /vm/Smalltalk.h: -------------------------------------------------------------------------------- 1 | #ifndef SMALLTALK_H 2 | #define SMALLTALK_H 3 | 4 | #include "Object.h" 5 | #include "String.h" 6 | #include "Dictionary.h" 7 | #include "Handle.h" 8 | 9 | #define SYMBOL_TABLE_SIZE 1024 10 | 11 | String *asSymbol(String *string); 12 | String *getSymbol(char *s); 13 | void setGlobal(char *key, Value value); 14 | void setGlobalObject(char *key, Object *value); 15 | Value getGlobal(char *key); 16 | Object *getGlobalObject(char *key); 17 | void globalAtPut(String *key, Value value); 18 | Value globalAt(String *key); 19 | Object *globalObjectAt(String *key); 20 | Class *getClass(char *key); 21 | void objectBecome(Object *object, Object *other); 22 | 23 | 24 | static _Bool isNil(void *p) 25 | { 26 | return ((Object *) p)->raw == Handles.nil->raw; 27 | } 28 | 29 | 30 | static _Bool isRawNil(void *p) 31 | { 32 | return (RawObject *) p == Handles.nil->raw; 33 | } 34 | 35 | 36 | static _Bool isTaggedNil(Value value) 37 | { 38 | return value == getTaggedPtr(Handles.nil); 39 | } 40 | 41 | 42 | static _Bool isTaggedTrue(Value value) 43 | { 44 | return value == getTaggedPtr(Handles.true); 45 | } 46 | 47 | 48 | static Object *asBool(_Bool bool) 49 | { 50 | return bool ? Handles.true : Handles.false; 51 | } 52 | 53 | #endif 54 | -------------------------------------------------------------------------------- /vm/Snapshot.h: -------------------------------------------------------------------------------- 1 | #ifndef SNAPSHOT_H 2 | #define SNAPSHOT_H 3 | 4 | #include 5 | 6 | void snapshotWrite(FILE *file); 7 | void snapshotRead(FILE *file); 8 | 9 | #endif 10 | -------------------------------------------------------------------------------- /vm/Socket.c: -------------------------------------------------------------------------------- 1 | #include "Socket.h" 2 | #include "Assert.h" 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | 10 | int socketConnect(uint32_t ip, uint16_t port) 11 | { 12 | int descriptor = socket(AF_INET, SOCK_STREAM, 0); 13 | struct sockaddr_in address; 14 | 15 | if (descriptor < 0) { 16 | return -1; 17 | } 18 | 19 | address.sin_family = AF_INET; 20 | address.sin_port = htons(port); 21 | memcpy(&address.sin_addr, &ip, sizeof(ip)); 22 | 23 | if (connect(descriptor, (struct sockaddr *) &address, sizeof(address)) != 0) { 24 | close(descriptor); 25 | return -1; 26 | } else { 27 | return descriptor; 28 | } 29 | } 30 | 31 | 32 | int socketBind(uint32_t ip, uint16_t port, int backlog) 33 | { 34 | int descriptor = socket(AF_INET, SOCK_STREAM, 0); 35 | struct sockaddr_in address; 36 | 37 | if (descriptor < 0) { 38 | return -1; 39 | } 40 | 41 | address.sin_family = AF_INET; 42 | address.sin_port = htons(port); 43 | memcpy(&address.sin_addr, &ip, sizeof(ip)); 44 | //address.sin_addr.s_addr = INADDR_ANY; 45 | 46 | if (bind(descriptor, (struct sockaddr *) &address, sizeof(address)) != 0) { 47 | close(descriptor); 48 | return -1; 49 | } 50 | if (listen(descriptor, backlog) != 0) { 51 | close(descriptor); 52 | return -1; 53 | } 54 | return descriptor; 55 | } 56 | 57 | 58 | int socketAccept(int descriptor) 59 | { 60 | return accept(descriptor, NULL, 0); 61 | } 62 | 63 | 64 | uint32_t socketHostLookup(char *host, const char **error) 65 | { 66 | struct addrinfo hints; 67 | struct addrinfo *addr; 68 | 69 | hints.ai_family = AF_INET; 70 | hints.ai_socktype = SOCK_STREAM; 71 | hints.ai_flags = 0; 72 | hints.ai_protocol = 0; 73 | hints.ai_canonname = NULL; 74 | hints.ai_addr = NULL; 75 | hints.ai_next = NULL; 76 | 77 | int result = getaddrinfo(host, NULL, &hints, &addr); 78 | if (result == 0) { 79 | ASSERT(addr->ai_addr->sa_family == AF_INET); 80 | uint32_t ip; 81 | memcpy(&ip, &((struct sockaddr_in *) addr->ai_addr)->sin_addr, sizeof(ip)); 82 | *error = NULL; 83 | freeaddrinfo(addr); 84 | return ip; 85 | } else { 86 | *error = gai_strerror(result); 87 | return 0; 88 | } 89 | } 90 | -------------------------------------------------------------------------------- /vm/Socket.h: -------------------------------------------------------------------------------- 1 | #ifndef SOCKET_H 2 | #define SOCKET_H 3 | 4 | #include "Object.h" 5 | #include 6 | 7 | typedef struct { 8 | OBJECT_HEADER; 9 | Value descriptor; 10 | } RawServerSocket; 11 | OBJECT_HANDLE(ServerSocket); 12 | 13 | typedef struct { 14 | OBJECT_HEADER; 15 | Value address; 16 | } RawInternetAddress; 17 | OBJECT_HANDLE(InternetAddress); 18 | 19 | int socketConnect(uint32_t ip, uint16_t port); 20 | int socketBind(uint32_t ip, uint16_t port, int backlog); 21 | int socketAccept(int descriptor); 22 | uint32_t socketHostLookup(char *host, const char **error); 23 | 24 | #endif 25 | -------------------------------------------------------------------------------- /vm/StackFrame.c: -------------------------------------------------------------------------------- 1 | #include "StackFrame.h" 2 | #include "Thread.h" 3 | #include "Smalltalk.h" 4 | #include "CompiledCode.h" 5 | #include "Heap.h" 6 | #include "Handle.h" 7 | #include "Assert.h" 8 | #include 9 | 10 | 11 | StackFrame *stackFrameGetParent(StackFrame *frame, EntryStackFrame *entryFrame) 12 | { 13 | if (frame->parent == entryFrame->entry) { 14 | return NULL; 15 | } 16 | return frame->parent; 17 | } 18 | 19 | 20 | RawContext *stackFrameGetContext(StackFrame *frame) 21 | { 22 | return (RawContext *) asObject(stackFrameGetSlot(frame, CONTEXT_SLOT)); 23 | } 24 | 25 | 26 | RawContext *stackFrameGetParentContext(StackFrame *frame) 27 | { 28 | StackFrame *parent = stackFrameGetParent(frame, CurrentThread.stackFramesTail); 29 | if (parent == NULL) { 30 | return NULL; 31 | } 32 | 33 | Value contextSlotValue = stackFrameGetSlot(parent, CONTEXT_SLOT); 34 | RawContext *context; 35 | if (contextSlotValue == CurrentThread.context) { 36 | context = (RawContext *) allocateObject(&CurrentThread.heap, Handles.MethodContext->raw, 0); 37 | context->frame = parent; 38 | context->code = tagPtr(stackFrameGetNativeCode(parent)->compiledCode); 39 | stackFrameSetSlot(parent, CONTEXT_SLOT, tagPtr(context)); 40 | } else { 41 | context = (RawContext *) asObject(contextSlotValue); 42 | } 43 | context->ic = tagInt((intptr_t) frame->parentIc/* - code->nativeCode->insts*/); 44 | return context; 45 | } 46 | 47 | 48 | void stackFrameSetArg(StackFrame *frame, ptrdiff_t index, Value value) 49 | { 50 | frame->args[index] = value; 51 | } 52 | 53 | 54 | Value stackFrameGetArg(StackFrame *frame, ptrdiff_t index) 55 | { 56 | return frame->args[index]; 57 | } 58 | 59 | 60 | Value *stackFrameGetArgPtr(StackFrame *frame, ptrdiff_t index) 61 | { 62 | return &frame->args[index]; 63 | } 64 | 65 | 66 | void stackFrameSetSlot(StackFrame *frame, ptrdiff_t index, Value value) 67 | { 68 | Value *slots = (Value *) frame - 1; 69 | slots[-index] = value; 70 | } 71 | 72 | 73 | Value stackFrameGetSlot(StackFrame *frame, ptrdiff_t index) 74 | { 75 | Value *slots = (Value *) frame - 1; 76 | return slots[-index]; 77 | } 78 | 79 | 80 | Value *stackFrameGetSlotPtr(StackFrame *frame, ptrdiff_t index) 81 | { 82 | Value *slots = (Value *) frame - 1; 83 | return &slots[-index]; 84 | } 85 | 86 | 87 | NativeCode *stackFrameGetNativeCode(StackFrame *frame) 88 | { 89 | return (NativeCode *) (stackFrameGetSlot(frame, FRAME_CODE_OFFSET) - offsetof(NativeCode, insts)); 90 | } 91 | 92 | 93 | _Bool contextHasValidFrame(RawContext *context) 94 | { 95 | return stackFrameGetSlot(context->frame, CONTEXT_SLOT) == tagPtr(context); 96 | } 97 | 98 | 99 | void printBacktrace(void) 100 | { 101 | EntryStackFrame *entryFrame = CurrentThread.stackFramesTail; 102 | while (entryFrame != NULL) { 103 | StackFrame *prev = entryFrame->exit; 104 | StackFrame *frame = stackFrameGetParent(prev, entryFrame); 105 | while (frame != NULL) { 106 | NativeCode *code = stackFrameGetNativeCode(frame); 107 | 108 | RawCompiledMethod *method = code->compiledCode; 109 | RawCompiledBlock *block = NULL; 110 | if (method->class == Handles.CompiledBlock->raw) { 111 | block = (RawCompiledBlock *) method; 112 | method = (RawCompiledMethod *) asObject(block->method); 113 | } 114 | 115 | RawClass *class = (RawClass *) asObject(method->ownerClass); 116 | if (class->class == Handles.MetaClass->raw) { 117 | class = (RawClass *) asObject(((RawMetaClass *) class)->instanceClass); 118 | } 119 | 120 | RawString *className = (RawString *) asObject(class->name); 121 | RawString *selector = (RawString *) asObject(method->selector); 122 | printf( 123 | "%p in %.*s#%.*s%s\n", 124 | (void *) prev->parentIc, 125 | (int) className->size, className->contents, 126 | (int) selector->size, selector->contents, 127 | block == NULL ? "" : "[]" 128 | ); 129 | 130 | prev = frame; 131 | frame = stackFrameGetParent(frame, entryFrame); 132 | } 133 | entryFrame = entryFrame->prev; 134 | } 135 | } 136 | -------------------------------------------------------------------------------- /vm/StackFrame.h: -------------------------------------------------------------------------------- 1 | #ifndef STACK_FRAME_H 2 | #define STACK_FRAME_H 3 | 4 | #define FRAME_VARS_OFFSET 2 5 | #define FRAME_CODE_OFFSET 0 6 | #define CONTEXT_SLOT 1 7 | 8 | #include "Thread.h" 9 | #include "Object.h" 10 | #include "CompiledCode.h" 11 | #include 12 | 13 | typedef struct StackFrame { 14 | // Value temps[]; 15 | // RawContext *context; 16 | struct StackFrame *parent; 17 | uint8_t *parentIc; 18 | Value args[]; 19 | } StackFrame; 20 | 21 | typedef struct EntryStackFrame { 22 | struct EntryStackFrame *prev; 23 | StackFrame *entry; 24 | StackFrame *exit; 25 | } EntryStackFrame; 26 | 27 | typedef struct { 28 | OBJECT_HEADER; 29 | Value size; 30 | Thread *thread; 31 | StackFrame *frame; 32 | Value ic; 33 | Value code; 34 | Value parent; 35 | Value outer; 36 | Value home; 37 | Value vars[]; 38 | } RawContext; 39 | OBJECT_HANDLE(Context); 40 | 41 | StackFrame *stackFrameGetParent(StackFrame *frame, EntryStackFrame *entryFrame); 42 | RawContext *stackFrameGetContext(StackFrame *frame); 43 | RawContext *stackFrameGetParentContext(StackFrame *frame); 44 | void stackFrameSetArg(StackFrame *frame, ptrdiff_t index, Value value); 45 | Value stackFrameGetArg(StackFrame *frame, ptrdiff_t index); 46 | Value *stackFrameGetArgPtr(StackFrame *frame, ptrdiff_t index); 47 | void stackFrameSetSlot(StackFrame *frame, ptrdiff_t index, Value value); 48 | Value stackFrameGetSlot(StackFrame *frame, ptrdiff_t index); 49 | Value *stackFrameGetSlotPtr(StackFrame *frame, ptrdiff_t index); 50 | NativeCode *stackFrameGetNativeCode(StackFrame *frame); 51 | _Bool contextHasValidFrame(RawContext *context); 52 | 53 | #endif 54 | -------------------------------------------------------------------------------- /vm/Stream.c: -------------------------------------------------------------------------------- 1 | #include "Stream.h" 2 | #include "Thread.h" 3 | #include "Handle.h" 4 | #include "Heap.h" 5 | #include "Assert.h" 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | 12 | #if !defined(TEMP_FAILURE_RETRY) 13 | #define TEMP_FAILURE_RETRY(expression) \ 14 | ({ \ 15 | int64_t __result; \ 16 | do { \ 17 | __result = (int64_t) expression; \ 18 | } while (__result == -1L && errno == EINTR); \ 19 | __result; \ 20 | }) 21 | #endif 22 | 23 | 24 | int streamOpen(RawString *fileName, intptr_t mode) 25 | { 26 | HandleScope scope; 27 | openHandleScope(&scope); 28 | String *fileNameHandle = scopeHandle(fileName); 29 | char space[256]; 30 | char *buffer = space; 31 | 32 | if (fileName->size > 256) { 33 | String *tmpString = (String *) copyResizedObject((Object *) fileNameHandle, fileName->size + 1); 34 | buffer = tmpString->raw->contents; 35 | buffer[fileName->size] = '\0'; 36 | } else { 37 | stringPrintOn(fileNameHandle, buffer); 38 | } 39 | 40 | closeHandleScope(&scope, NULL); 41 | 42 | mode_t openMode = 0; 43 | switch (mode) { 44 | case 1: 45 | openMode = O_RDONLY; 46 | break; 47 | case 1 << 1: 48 | openMode = O_WRONLY; 49 | break; 50 | case 1 << 2: 51 | openMode = O_RDWR; 52 | break; 53 | default: 54 | return -1; 55 | } 56 | 57 | return TEMP_FAILURE_RETRY(open(buffer, openMode)); 58 | } 59 | 60 | 61 | _Bool streamClose(int descriptor) 62 | { 63 | return close(descriptor) == 0; 64 | } 65 | 66 | 67 | ptrdiff_t streamRead(int descriptor, void *buffer, size_t size) 68 | { 69 | return TEMP_FAILURE_RETRY(read(descriptor, buffer, size)); 70 | } 71 | 72 | 73 | ptrdiff_t streamWrite(int descriptor, void *buffer, size_t size) 74 | { 75 | return TEMP_FAILURE_RETRY(write(descriptor, buffer, size)); 76 | } 77 | 78 | 79 | _Bool streamFlush(int descriptor) 80 | { 81 | return TEMP_FAILURE_RETRY(fsync(descriptor)) == 0; 82 | } 83 | 84 | 85 | /*_Bool streamAtEnd(RawFileStream *stream) 86 | { 87 | return feof(stream->file); 88 | }*/ 89 | 90 | 91 | ptrdiff_t streamGetPosition(int descriptor) 92 | { 93 | return TEMP_FAILURE_RETRY(lseek(descriptor, 0, SEEK_CUR)); 94 | } 95 | 96 | 97 | _Bool streamSetPosition(int descriptor, ptrdiff_t position) 98 | { 99 | return TEMP_FAILURE_RETRY(lseek(descriptor, position, SEEK_SET)) != -1; 100 | } 101 | 102 | 103 | intptr_t streamAvailable(int descriptor) 104 | { 105 | int available; 106 | int result = TEMP_FAILURE_RETRY(ioctl(descriptor, FIONREAD, &available)); 107 | if (result < 0) { 108 | return result; 109 | } 110 | return available; 111 | } 112 | 113 | 114 | IoError *getLastIoError(void) 115 | { 116 | HandleScope scope; 117 | openHandleScope(&scope); 118 | 119 | char msg[256] = "IoError: "; 120 | strerror_r(errno, msg + 9, 256 - 9); 121 | IoError *error = newObject(Handles.IoError, 0); 122 | objectStorePtr((Object *) error, &error->raw->messageText, (Object *) asString(msg)); 123 | 124 | return closeHandleScope(&scope, error); 125 | } 126 | -------------------------------------------------------------------------------- /vm/Stream.h: -------------------------------------------------------------------------------- 1 | #ifndef FILE_STREAM_H 2 | #define FILE_STREAM_H 3 | 4 | #include "Object.h" 5 | #include "String.h" 6 | 7 | #define EXTERNAL_STREAM_BODY \ 8 | OBJECT_HEADER; \ 9 | Value buffer; \ 10 | Value position; \ 11 | Value buffered; \ 12 | Value atEnd; \ 13 | Value descriptor 14 | 15 | typedef struct { 16 | EXTERNAL_STREAM_BODY; 17 | } RawExternalStream; 18 | OBJECT_HANDLE(ExternalStream); 19 | 20 | typedef struct { 21 | EXTERNAL_STREAM_BODY; 22 | Value name; 23 | } RawFileStream; 24 | OBJECT_HANDLE(FileStream); 25 | 26 | typedef struct { 27 | OBJECT_HEADER; 28 | Value messageText; 29 | } RawIoError; 30 | OBJECT_HANDLE(IoError); 31 | 32 | int streamOpen(RawString *fileName, intptr_t mode); 33 | _Bool streamClose(int descriptor); 34 | ptrdiff_t streamRead(int descriptor, void *buffer, size_t size); 35 | ptrdiff_t streamWrite(int descriptor, void *buffer, size_t size); 36 | _Bool streamFlush(int descriptor); 37 | _Bool streamAtEnd(int descriptor); 38 | ptrdiff_t streamGetPosition(int descriptor); 39 | _Bool streamSetPosition(int descriptor, ptrdiff_t position); 40 | intptr_t streamAvailable(int descriptor); 41 | IoError *getLastIoError(void); 42 | 43 | #endif 44 | 45 | -------------------------------------------------------------------------------- /vm/String.c: -------------------------------------------------------------------------------- 1 | #include "String.h" 2 | #include "Thread.h" 3 | #include "Heap.h" 4 | #include "Smalltalk.h" 5 | #include "Handle.h" 6 | #include "../cityhash/city.h" 7 | #include 8 | 9 | 10 | String *newString(size_t size) 11 | { 12 | return (String *) newObject(Handles.String, size); 13 | } 14 | 15 | 16 | String *asString(char *buffer) 17 | { 18 | size_t size = strlen(buffer); 19 | String *string = newString(size); 20 | memcpy(string->raw->contents, buffer, size); 21 | return string; 22 | } 23 | 24 | 25 | Value computeStringHash(String *string) 26 | { 27 | return computeRawStringHash(string->raw); 28 | } 29 | 30 | 31 | Value computeRawStringHash(RawString *string) 32 | { 33 | return CityHash64(string->contents, string->size) << 2 >> 2; 34 | } 35 | 36 | 37 | _Bool stringEquals(String *a, String *b) 38 | { 39 | return a->raw->size == b->raw->size && memcmp(a->raw->contents, b->raw->contents, a->raw->size) == 0; 40 | } 41 | 42 | 43 | _Bool stringEqualsC(String *a, char *b) 44 | { 45 | size_t size = strlen(b); 46 | return a->raw->size == size && memcmp(a->raw->contents, b, size) == 0; 47 | } 48 | 49 | 50 | void stringPrintOn(String *str, char *buffer) 51 | { 52 | memcpy(buffer, str->raw->contents, str->raw->size); 53 | buffer[str->raw->size] = '\0'; 54 | } 55 | 56 | 57 | size_t computeArguments(String *selector) 58 | { 59 | size_t size = selector->raw->size; 60 | char *s = selector->raw->contents; 61 | char *end = s + size; 62 | size_t count = 0; 63 | 64 | if (s[size - 1] == ':') { 65 | while (s != end && (s = memchr(s, ':', end - s)) != NULL) { 66 | count++; 67 | s++; 68 | } 69 | } else if ((s[0] < 'A' || s[0] > 'Z') && (s[0] < 'a' || s[1] > 'z')) { 70 | count++; 71 | } 72 | return count; 73 | } 74 | 75 | 76 | void printValue(Value value) 77 | { 78 | if (valueTypeOf(value, VALUE_CHAR)) { 79 | printf("%c", asCChar(value)); 80 | } else if (valueTypeOf(value, VALUE_INT)) { 81 | printf("%zi", asCInt(value)); 82 | } else { 83 | printRawObject(asObject(value)); 84 | } 85 | } 86 | 87 | 88 | void printRawObject(RawObject *object) 89 | { 90 | RawString *string; 91 | if (object->class == Handles.String->raw) { 92 | string = (RawString *) object; 93 | } else if (object->class == Handles.Symbol->raw) { 94 | printf("#"); 95 | string = (RawString *) object; 96 | } else if (object->class->class == Handles.MetaClass->raw) { 97 | string = (RawString *) asObject(((RawClass *) object)->name); 98 | } else if (object->class == Handles.MetaClass->raw) { 99 | RawMetaClass *metaClass = (RawMetaClass *) object; 100 | RawClass *class = (RawClass *) asObject(metaClass->instanceClass); 101 | string = (RawString *) asObject(class->name); 102 | } else { 103 | string = (RawString *) asObject(object->class->name); 104 | printf("a "); 105 | } 106 | printRawString(string); 107 | } 108 | 109 | 110 | void printRawString(RawString *string) 111 | { 112 | ASSERT(string->class == Handles.String->raw || string->class == Handles.Symbol->raw); 113 | printf("%.*s", (int) string->size, string->contents); 114 | } 115 | -------------------------------------------------------------------------------- /vm/String.h: -------------------------------------------------------------------------------- 1 | #ifndef STRING_H 2 | #define STRING_H 3 | 4 | #include "Object.h" 5 | 6 | typedef struct { 7 | OBJECT_HEADER; 8 | Value size; 9 | char contents[]; 10 | } RawString; 11 | OBJECT_HANDLE(String); 12 | 13 | String *newString(size_t size); 14 | String *asString(char *buffer); 15 | 16 | Value computeStringHash(String *string); 17 | Value computeRawStringHash(RawString *string); 18 | _Bool stringEquals(String *a, String *b); 19 | _Bool stringEqualsC(String *a, char *b); 20 | void stringPrintOn(String *str, char *buffer); 21 | size_t computeArguments(String *selector); 22 | void printValue(Value value); 23 | void printRawObject(RawObject *object); 24 | void printRawString(RawString *string); 25 | 26 | #endif 27 | -------------------------------------------------------------------------------- /vm/StubCode.h: -------------------------------------------------------------------------------- 1 | #ifndef STUBCODE_H 2 | #define STUBCODE_H 3 | 4 | #include "CompiledCode.h" 5 | #include "CodeGenerator.h" 6 | #include "Assembler.h" 7 | 8 | typedef struct { 9 | void (*generator)(CodeGenerator *generator); 10 | NativeCode *nativeCode; 11 | } StubCode; 12 | 13 | extern StubCode SmalltalkEntry; 14 | extern StubCode AllocateStub; 15 | extern StubCode LookupStub; 16 | extern StubCode DoesNotUnderstandStub; 17 | 18 | NativeCode *getStubNativeCode(StubCode *stub); 19 | void generateStubCall(CodeGenerator *generator, StubCode *stubCode); 20 | 21 | #endif 22 | -------------------------------------------------------------------------------- /vm/Thread.c: -------------------------------------------------------------------------------- 1 | #include "Thread.h" 2 | #include "StackFrame.h" 3 | #include "Heap.h" 4 | #include "Handle.h" 5 | #include "Assert.h" 6 | 7 | __thread Thread CurrentThread = { 0 }; 8 | 9 | 10 | void initThread(Thread *thread) 11 | { 12 | initHeap(&thread->heap, thread); 13 | thread->stackFramesTail = NULL; 14 | } 15 | 16 | 17 | void initThreadContext(Thread *thread) 18 | { 19 | if (thread->context == 0) { 20 | RawContext *context = (RawContext *) allocateObject(&CurrentThread.heap, Handles.MethodContext->raw, 0); 21 | context->thread = thread; 22 | thread->context = tagPtr(context); 23 | } 24 | } 25 | 26 | 27 | void freeThread(Thread *thread) 28 | { 29 | thread->context = 0; 30 | freeHeap(&thread->heap); 31 | } 32 | 33 | 34 | void threadSetExitFrame(StackFrame *stackFrame) 35 | { 36 | CurrentThread.stackFramesTail->exit = stackFrame; 37 | } 38 | -------------------------------------------------------------------------------- /vm/Thread.h: -------------------------------------------------------------------------------- 1 | #ifndef THREAD_H 2 | #define THREAD_H 3 | 4 | #include "Heap.h" 5 | 6 | struct HandleScope; 7 | struct StackFrame; 8 | struct EntryStackFrame; 9 | 10 | typedef struct Thread { 11 | Heap heap; 12 | struct Handle *handles; 13 | struct HandleScope *handleScopes; 14 | Value context; 15 | struct EntryStackFrame *stackFramesTail; 16 | } Thread; 17 | 18 | extern __thread Thread CurrentThread; 19 | 20 | void initThread(Thread *thread); 21 | void initThreadContext(Thread *thread); 22 | void freeThread(Thread *thread); 23 | void threadSetExitFrame(struct StackFrame *stackFrame); 24 | 25 | 26 | static inline void rawObjectStorePtr(RawObject *object, Value *field, RawObject *value) 27 | { 28 | if (isOldObject(object) && isNewObject(value) && (object->tags & TAG_REMEMBERED) == 0) { 29 | rememberedSetAdd(&CurrentThread.heap.rememberedSet, object); 30 | } 31 | *field = tagPtr(value); 32 | } 33 | 34 | 35 | static inline void objectStorePtr(Object *object, Value *field, Object *value) 36 | { 37 | rawObjectStorePtr(object->raw, field, value->raw); 38 | } 39 | 40 | #endif 41 | -------------------------------------------------------------------------------- /vm/Tokenizer.h: -------------------------------------------------------------------------------- 1 | #ifndef TOKENIZER_H 2 | #define TOKENIZER_H 3 | 4 | #include 5 | #include 6 | 7 | #define MAX_TOKENS 6 8 | #define TOKEN_BUFFER_SIZE 64 9 | 10 | typedef enum 11 | { 12 | TOKEN_NONE = 1, 13 | TOKEN_UNKNOWN = 1 << 1, 14 | TOKEN_DIGIT = 1 << 2, 15 | TOKEN_IDENTIFIER = 1 << 3, 16 | TOKEN_SYMBOL_START = 1 << 4, 17 | TOKEN_CHAR = 1 << 5, 18 | TOKEN_STRING = 1 << 6, 19 | TOKEN_COMMENT = 1 << 7, 20 | TOKEN_SPECIAL_CHARS = 1 << 8, 21 | TOKEN_KEYWORD = 1 << 9, 22 | TOKEN_ASSIGN = 1 << 10, 23 | TOKEN_RETURN = 1 << 11, 24 | TOKEN_DOT = 1 << 12, 25 | TOKEN_ARRAY_OPEN_BRACKET = 1 << 13, 26 | TOKEN_OPEN_BRACKET = 1 << 14, 27 | TOKEN_CLOSE_BRACKET = 1 << 15, 28 | TOKEN_OPEN_SQUARE_BRACKET = 1 << 16, 29 | TOKEN_CLOSE_SQUARE_BRACKET = 1 << 17, 30 | TOKEN_END_OF_INPUT = 1 << 18, 31 | TOKEN_COLON = 1 << 19, 32 | TOKEN_SEMICOLON = 1 << 20, 33 | TOKEN_VERTICAL_BAR = 1 << 21, 34 | TOKEN_LESS_THAN = 1 << 22, 35 | TOKEN_GREATER_THAN = 1 << 23, 36 | TOKEN_MINUS = 1 << 24, 37 | TOKEN_UNCLOSED_STRING = 1 << 25, 38 | TOKEN_UNCLOSED_COMMENT = 1 << 26, 39 | } TokenType; 40 | 41 | typedef struct Token { 42 | TokenType type; 43 | size_t contentSize; 44 | char *content; 45 | char buffer[TOKEN_BUFFER_SIZE]; 46 | size_t position, line, column; 47 | _Bool isSeparated; 48 | } Token; 49 | 50 | typedef struct { 51 | _Bool isFile; 52 | union { 53 | char *memory; 54 | FILE *file; 55 | } source; 56 | 57 | char *current, ch; 58 | size_t line, column; 59 | 60 | Token tokens[MAX_TOKENS]; 61 | size_t tokenIndex, tokenized; 62 | Token comment; 63 | } Tokenizer; 64 | 65 | 66 | void initTokenizer(Tokenizer *tokenizer, char *source); 67 | void initFileTokenizer(Tokenizer *tokenizer, FILE *file); 68 | void freeTokenizer(Tokenizer *tokenizer); 69 | 70 | Token *currentToken(Tokenizer *tokenizer); 71 | Token *skipToken(Tokenizer *tokenizer, int8_t steps); 72 | Token *prevToken(Tokenizer *tokenizer); 73 | Token *nextToken(Tokenizer *tokenizer); 74 | Token *peekToken(Tokenizer *tokenizer); 75 | Token *peekNthToken(Tokenizer *tokenizer, int8_t steps); 76 | Token *peekForToken(Tokenizer *tokenizer, TokenType type); 77 | 78 | #endif 79 | -------------------------------------------------------------------------------- /vm/TokenizerTest.c: -------------------------------------------------------------------------------- 1 | #include "Tokenizer.h" 2 | #include "Assert.h" 3 | #include 4 | #include 5 | #include 6 | 7 | 8 | void testNextToken(Tokenizer *tokenizer) 9 | { 10 | Token *token; 11 | 12 | token = currentToken(tokenizer); 13 | ASSERT(token->type == TOKEN_DIGIT); 14 | ASSERT(strcmp(token->content, "123") == 0); 15 | 16 | token = nextToken(tokenizer); 17 | ASSERT(token->type == TOKEN_IDENTIFIER); 18 | ASSERT(strcmp(token->content, "abc") == 0); 19 | 20 | token = nextToken(tokenizer); 21 | ASSERT(token->type == TOKEN_KEYWORD); 22 | ASSERT(strcmp(token->content, "efg:") == 0); 23 | 24 | token = nextToken(tokenizer); 25 | ASSERT(token->type == TOKEN_OPEN_SQUARE_BRACKET); 26 | ASSERT(strcmp(token->content, "[") == 0); 27 | 28 | token = nextToken(tokenizer); 29 | ASSERT(token->type == TOKEN_CLOSE_SQUARE_BRACKET); 30 | ASSERT(strcmp(token->content, "]") == 0); 31 | 32 | token = nextToken(tokenizer); 33 | ASSERT(token->type == TOKEN_SYMBOL_START); 34 | ASSERT(strcmp(token->content, "#") == 0); 35 | 36 | token = nextToken(tokenizer); 37 | ASSERT(token->type == TOKEN_IDENTIFIER); 38 | ASSERT(strcmp(token->content, "foo") == 0); 39 | 40 | token = nextToken(tokenizer); 41 | ASSERT(token->type == TOKEN_CHAR); 42 | ASSERT(strcmp(token->content, "$a") == 0); 43 | 44 | token = nextToken(tokenizer); 45 | ASSERT(token->type == TOKEN_STRING); 46 | ASSERT(strcmp(token->content, "abc") == 0); 47 | 48 | token = nextToken(tokenizer); 49 | ASSERT(token->type == TOKEN_STRING); 50 | ASSERT(strcmp(token->content, "a'b") == 0); 51 | 52 | token = nextToken(tokenizer); 53 | ASSERT(token->type == TOKEN_STRING); 54 | ASSERT(strcmp(token->content, "") == 0); 55 | 56 | token = nextToken(tokenizer); 57 | ASSERT(token->type == TOKEN_STRING); 58 | ASSERT(strcmp(token->content, "'") == 0); 59 | 60 | token = nextToken(tokenizer); 61 | ASSERT(token->type == TOKEN_ASSIGN); 62 | ASSERT(strcmp(token->content, ":=") == 0); 63 | 64 | token = nextToken(tokenizer); 65 | ASSERT(token->type == TOKEN_DIGIT); 66 | ASSERT(strcmp(token->content, "16r09AF") == 0); 67 | 68 | token = nextToken(tokenizer); 69 | ASSERT(token->type == TOKEN_ARRAY_OPEN_BRACKET); 70 | ASSERT(strcmp(token->content, "#(") == 0); 71 | 72 | token = nextToken(tokenizer); 73 | ASSERT(token->type == TOKEN_SEMICOLON); 74 | ASSERT(strcmp(token->content, ";") == 0); 75 | } 76 | 77 | 78 | void testNextTokenWithString(void) 79 | { 80 | Tokenizer tokenizer; 81 | 82 | initTokenizer(&tokenizer, "123 abc efg: [ ] #foo $a 'abc' 'a''b' '' '''' := 16r09AF #( ;"); 83 | testNextToken(&tokenizer); 84 | freeTokenizer(&tokenizer); 85 | 86 | } 87 | 88 | 89 | void testNextTokenWithFile(void) 90 | { 91 | Tokenizer tokenizer; 92 | FILE *file = tmpfile(); 93 | 94 | fputs(" 123 abc efg: [ ] #foo $a 'abc' 'a''b' '' '''' := 16r09AF #( ;", file); 95 | rewind(file); 96 | initFileTokenizer(&tokenizer, file); 97 | testNextToken(&tokenizer); 98 | freeTokenizer(&tokenizer); 99 | fclose(file); 100 | } 101 | 102 | 103 | void testSkipToken(void) 104 | { 105 | Tokenizer tokenizer; 106 | Token *token; 107 | 108 | initTokenizer(&tokenizer, "1 a ( ) [ ]"); 109 | token = skipToken(&tokenizer, 4); 110 | ASSERT(token->type == TOKEN_OPEN_SQUARE_BRACKET); 111 | 112 | token = skipToken(&tokenizer, -1); 113 | } 114 | 115 | 116 | int main(void) 117 | { 118 | testNextTokenWithString(); 119 | testNextTokenWithFile(); 120 | testSkipToken(); 121 | 122 | return 0; 123 | } 124 | -------------------------------------------------------------------------------- /vm/Variable.h: -------------------------------------------------------------------------------- 1 | #ifndef VARIABLE_H 2 | #define VARIABLE_H 3 | 4 | #include "Object.h" 5 | 6 | typedef struct { 7 | uint8_t tag; 8 | uint8_t type; 9 | uint8_t index; 10 | uint8_t level; 11 | uint8_t ctxCopy; 12 | uint8_t unused0; 13 | uint8_t unused1; 14 | uint8_t unused2; 15 | } Variable; 16 | 17 | 18 | static Value defineVariable(uint8_t type, uint8_t index, uint8_t level) 19 | { 20 | Variable tmp; 21 | tmp.tag = 0; 22 | tmp.type = type; 23 | tmp.index = index; 24 | tmp.level = level; 25 | tmp.ctxCopy = 0; 26 | tmp.unused0 = 0; 27 | tmp.unused1 = 0; 28 | tmp.unused2 = 0; 29 | return *(Value *) &tmp; 30 | } 31 | 32 | 33 | static void setVarType(Value *var, uint8_t type) 34 | { 35 | ((Variable *) var)->type = type; 36 | } 37 | 38 | 39 | static uint8_t getVarType(Value var) 40 | { 41 | return ((Variable *) &var)->type; 42 | } 43 | 44 | 45 | static void setVarIndex(Value *var, uint8_t index) 46 | { 47 | ((Variable *) var)->index = index; 48 | } 49 | 50 | 51 | static uint8_t getVarIndex(Value var) 52 | { 53 | return ((Variable *) &var)->index; 54 | } 55 | 56 | 57 | static void setVarLevel(Value *var, uint8_t level) 58 | { 59 | ((Variable *) var)->level = level; 60 | } 61 | 62 | 63 | static uint8_t getVarLevel(Value var) 64 | { 65 | return ((Variable *) &var)->level; 66 | } 67 | 68 | 69 | static void setVarCtxCopy(Value *var, uint8_t index) 70 | { 71 | ((Variable *) var)->ctxCopy = index + 1; 72 | } 73 | 74 | 75 | static uint8_t getVarCtxCopy(Value var) 76 | { 77 | return ((Variable *) &var)->ctxCopy - 1; 78 | } 79 | 80 | 81 | static _Bool hasVarCtxCopy(Value var) 82 | { 83 | return ((Variable *) &var)->ctxCopy != 0; 84 | } 85 | 86 | 87 | #endif 88 | --------------------------------------------------------------------------------