├── src ├── version.h.in ├── testdata │ ├── README │ └── LICENSE ├── version.c ├── feline_home.c ├── math.c ├── hashtable-common.asm ├── stress.feline ├── stack.asm ├── chars.feline ├── sequences.feline ├── declare.feline ├── tokenize.feline ├── dump.feline ├── math.asm ├── backtrace.c ├── boolean.asm ├── control.feline ├── random.c ├── control-test.feline ├── syntax.feline ├── unit-test.feline ├── strings.feline ├── debug.asm ├── backtrace.feline ├── compiler-tests.feline ├── io.asm ├── xalloc.asm ├── time.asm ├── move.asm ├── socket.asm ├── externs.asm ├── wrapper.asm ├── feline.h ├── boot.feline ├── help.feline ├── defer.asm ├── memory.asm ├── lvar.asm ├── inspector.feline ├── tuple.feline ├── key.asm ├── feline.asm ├── tuple.asm ├── recover.asm └── keyword.asm ├── examples └── .init.feline ├── .gitattributes ├── benchmarks ├── gc0.feline ├── bench.h ├── xorshift128+.lisp ├── xorshift128+.c ├── string-find-char-from-index.feline ├── vector-remove-nth.feline ├── xorshift128+.feline └── bench-hashtable.feline ├── .gitignore ├── Makefile ├── feral ├── feral-commands.feline ├── modes.feline ├── editor.feline ├── editorx.feline ├── mini.feline ├── ansi-color.feline ├── keymaps.feline ├── feral-key.feline ├── feral-hooks.feline ├── feral-config.feline ├── completion.feline ├── directories.feline ├── feral.feline ├── termui-minibuffer.feline ├── quit.feline ├── logging.feline ├── kill-ring.feline ├── gtkui-display.feline ├── segments.feline ├── minibuffer-common.feline ├── early-feline-mode.feline ├── winui-display.feline ├── list-symbols.feline ├── display.feline ├── symbols-mode.feline ├── find-definition.feline ├── lisp-mode.feline ├── asm-mode.feline ├── history.feline ├── diff-mode.feline ├── feral-colors.feline ├── feral-loader.feline ├── accept-string.feline ├── save.feline ├── list-buffers.feline ├── termui-key.feline ├── search-mode.feline └── disassembly-mode.feline └── CREDITS /src/version.h.in: -------------------------------------------------------------------------------- 1 | #define RELEASE_VERSION "0.0.0.64" 2 | -------------------------------------------------------------------------------- /examples/.init.feline: -------------------------------------------------------------------------------- 1 | using: feline ; 2 | in: user 3 | 4 | +color 5 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | * text eol=lf 2 | *.asm text 3 | *.c text 4 | *.feline text 5 | -------------------------------------------------------------------------------- /src/testdata/README: -------------------------------------------------------------------------------- 1 | Test data from AT&T Open Source on GitHub https://github.com/att/ast 2 | 3 | The LICENSE in this directory is extracted from testregex.c. 4 | -------------------------------------------------------------------------------- /benchmarks/gc0.feline: -------------------------------------------------------------------------------- 1 | using: feline ; 2 | in: gc0 3 | 4 | empty 5 | 6 | // factor/extra/benchmark/gc0/gc0.factor 7 | 8 | : allocate 10 make-array/1 ; 9 | 10 | : gc0 f 60000000 [ allocate nip ] times drop ; 11 | 12 | : test [ gc0 ] time ; 13 | -------------------------------------------------------------------------------- /benchmarks/bench.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | uint64_t ticks() 6 | { 7 | struct timeval tv; 8 | if(gettimeofday(&tv, NULL) != 0) 9 | return 0; 10 | return (tv.tv_sec * 1000) + (tv.tv_usec / 1000); 11 | } 12 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | forth 3 | feline 4 | *.zip 5 | *.obj 6 | forth.exe 7 | feline.exe 8 | *.pdb 9 | feline_home 10 | feline_home.exe 11 | feline_home.asm 12 | version.h 13 | version.asm 14 | a.out 15 | benchmarks/xorshift128+ 16 | benchmarks/xorshift128+.exe 17 | build 18 | *~ 19 | 20 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | ifeq ($(OS),Windows_NT) 2 | FELINE_EXE = feline.exe 3 | else 4 | FELINE_EXE = feline 5 | endif 6 | 7 | all: $(FELINE_EXE) 8 | 9 | $(FELINE_EXE): 10 | cd src && $(MAKE) ../$(FELINE_EXE) 11 | 12 | clean: 13 | -rm -f feline feline.exe build 14 | cd src && $(MAKE) clean 15 | -------------------------------------------------------------------------------- /src/version.c: -------------------------------------------------------------------------------- 1 | #include "version.h" 2 | 3 | char * version () 4 | { 5 | #ifdef REPOSITORY_VERSION 6 | return REPOSITORY_VERSION; 7 | #else 8 | return RELEASE_VERSION; 9 | #endif 10 | } 11 | 12 | char * build () 13 | { 14 | #ifdef BUILD 15 | return BUILD; 16 | #else 17 | return ""; 18 | #endif 19 | } 20 | -------------------------------------------------------------------------------- /src/feline_home.c: -------------------------------------------------------------------------------- 1 | #include 2 | #ifndef _MSC_VER 3 | #include 4 | #endif 5 | 6 | int main() 7 | { 8 | #ifdef WIN64 9 | char sep = '\\'; 10 | #else 11 | char sep = '/'; 12 | #endif 13 | char buf[1024]; 14 | FILE *file; 15 | int i = 0; 16 | chdir(".."); 17 | getcwd(buf, sizeof(buf)); 18 | file = fopen("src/feline_home.asm", "w"); 19 | if (file) 20 | { 21 | fprintf(file, "%%define FELINE_HOME \"%s\"\n", buf); 22 | fprintf(file, "%%define FELINE_SOURCE_DIR \"%s%csrc\"\n", buf, sep); 23 | fclose(file); 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /benchmarks/xorshift128+.lisp: -------------------------------------------------------------------------------- 1 | (defvar state0) 2 | (defvar state1) 3 | 4 | (declaim (inline mod64)) 5 | (defun mod64 (x) (declare (type integer x)) (mod x (expt 2 64))) 6 | 7 | (defun xorshift128+ () 8 | (declare (optimize speed)) 9 | (let ((s1 state0) (s0 state1)) 10 | (setf state0 s0) 11 | (setf s1 (logxor (mod64 (ash s1 23)) s1)) 12 | (setf s1 (logxor (ash s1 -17) s1)) 13 | (setf s1 (logxor s1 s0)) 14 | (setf s1 (logxor (ash s0 -26) s1)) 15 | (setf state1 s1))) 16 | 17 | (defun test () 18 | (gc) 19 | (setf state0 1) 20 | (setf state1 2) 21 | (time (dotimes (i 10000000) (xorshift128+))) 22 | (format t "state0 = ~D~%" state0) 23 | (format t "state1 = ~D~%" state1)) 24 | -------------------------------------------------------------------------------- /benchmarks/xorshift128+.c: -------------------------------------------------------------------------------- 1 | #include "bench.h" 2 | 3 | uint64_t state0 = 1; 4 | uint64_t state1 = 2; 5 | 6 | uint64_t xorshift128plus() 7 | { 8 | uint64_t s1 = state0; 9 | uint64_t s0 = state1; 10 | state0 = s0; 11 | s1 ^= s1 << 23; 12 | s1 ^= s1 >> 17; 13 | s1 ^= s0; 14 | s1 ^= s0 >> 26; 15 | state1 = s1; 16 | return state0 + state1; 17 | } 18 | 19 | int main(int argc, char** argv) 20 | { 21 | uint64_t t1, t2; 22 | t1 = ticks(); 23 | for (int i = 0; i < 10000000; i++) 24 | xorshift128plus(); 25 | t2 = ticks(); 26 | printf("%ld ms\n", t2 - t1); 27 | #ifdef WIN64 28 | printf("state0 = %llu\n", state0); 29 | printf("state1 = %llu\n", state1); 30 | #else 31 | printf("state0 = %lu\n", state0); 32 | printf("state1 = %lu\n", state1); 33 | #endif 34 | } 35 | 36 | // gcc xorshift128+.c -o xorshift128+ 37 | -------------------------------------------------------------------------------- /feral/feral-commands.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feral-commands 18 | 19 | empty 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /benchmarks/string-find-char-from-index.feline: -------------------------------------------------------------------------------- 1 | using: feline ; 2 | in: user 3 | 4 | 0 't' "" string-find-char-from-index nil assert-eq 5 | 6 | 1000000 constant reps 7 | 8 | "test" constant s1 9 | 10 | 0 't' s1 string-find-char-from-index 0 assert-eq 11 | 12 | : %test1 13 | reps [ 0 't' s1 string-find-char-from-index drop ] times ; 14 | 15 | : test1 [ %test1 ] time ; 16 | 17 | "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxtest" constant s2 18 | 19 | 0 't' s2 string-find-char-from-index 36 assert-eq 20 | 21 | : %test2 22 | reps [ 0 't' s2 string-find-char-from-index drop ] times ; 23 | 24 | : test2 [ %test2 ] time ; 25 | 26 | "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxtest" constant s3 27 | 28 | 0 't' s3 string-find-char-from-index 76 assert-eq 29 | 30 | : %test3 31 | reps [ 0 't' s3 string-find-char-from-index drop ] times ; 32 | 33 | : test3 [ %test3 ] time ; 34 | -------------------------------------------------------------------------------- /src/math.c: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2017 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | #include 17 | 18 | #include "feline.h" 19 | 20 | cell c_float_sin(Float *p) 21 | { 22 | return (cell) make_float(sin(p->d)); 23 | } 24 | -------------------------------------------------------------------------------- /benchmarks/vector-remove-nth.feline: -------------------------------------------------------------------------------- 1 | using: feline ; 2 | in: user 3 | 4 | 1000 constant n 5 | 6 | global v 7 | 8 | : test1 9 | 100 v vector-remove-nth! 10 | 100 100 v vector-insert-nth 11 | ; 12 | 13 | : test 14 | n v! 15 | n [ v vector-push ] each-integer 16 | gc 17 | [ 1000000 ' test1 times ] time 18 | ; 19 | 20 | -- lenny (windows) 21 | -- 2283 ms cmove 22 | -- 2512 ms move_cells_down no rep movsq 23 | -- 2284 ms move_cells_down rep movsq 24 | -- 460 ms 0.0.0.23-43-g564d5767 25 | -- 447 ms 0.0.0.30-85-g263086ef 26 | 27 | -- lenny (ubuntu) 28 | -- 433 ms 0.0.0.23-43-g564d5767 29 | 30 | -- cosmo 31 | -- 8989 ms cmove 32 | -- 5663 ms move_cells_down no rep movsq 33 | -- 5151 ms move_cells_down rep movsq 34 | -- 1327 ms move_cells_up rep movsq 35 | 36 | -- arch 37 | -- 3139 ms cmove 0.0.0.23-40-gbe58ebf9 38 | -- 853 ms 0.0.0.23-43-g564d5767 39 | -------------------------------------------------------------------------------- /src/hashtable-common.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2016-2020 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; ### +empty+ 19 | feline_constant empty_marker, '+empty+', S_empty_marker 20 | 21 | ; ### +deleted+ 22 | feline_constant deleted_marker, '+deleted+', S_deleted_marker 23 | -------------------------------------------------------------------------------- /src/stress.feline: -------------------------------------------------------------------------------- 1 | using: feline ; 2 | in: user 3 | 4 | "stress" delete-vocab 5 | 6 | in: stress 7 | 8 | 4000000 constant limit 9 | 10 | // The followings tests verify that the quotation remains valid through gc, 11 | // even if there is no other reference to it. These tests must not be in a 12 | // definition, since in that case the symbol-def slot would hold a reference 13 | // to the quotation. 14 | 15 | "each-integer-gc-test-1" ?nl write-string 16 | limit [ number>string drop ] each-integer 17 | 18 | "find-integer-gc-test-1" ?nl write-string 19 | limit [ number>string "9999999" string=? ] find-integer drop 20 | 21 | "times-gc-test-1" ?nl write-string 22 | limit [ most-positive-fixnum number>string drop ] times 23 | 24 | "until-gc-test-1" ?nl write-string 25 | limit [ dup zero? ] [ dup number>string drop 1 - ] until drop 26 | 27 | "while-gc-test-1" ?nl write-string 28 | limit [ dup zero? not ] [ dup number>string drop 1 - ] while drop 29 | 30 | ?nl "Reached end of stress.feline" write-string 31 | -------------------------------------------------------------------------------- /feral/modes.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline accessors feral-config ; 17 | in: modes 18 | 19 | global modes 20 | 21 | : initialize-modes 8 modes! ; 22 | 23 | : mode-from-extension // string -> mode/nil 24 | modes at ; 25 | 26 | initialize-modes 27 | -------------------------------------------------------------------------------- /feral/editor.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2017-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feral-config 18 | 19 | empty 20 | 21 | constant: standalone? nil ; 22 | 23 | constant: winui? nil ; 24 | constant: gtkui? nil ; 25 | 26 | constant: termui? true ; 27 | 28 | feline-home "feral" path-append "feral-main.feline" path-append load 29 | -------------------------------------------------------------------------------- /src/stack.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2012-2018 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | %macro _depth 0 19 | _ current_thread_raw_sp0 20 | sub rbx, rbp 21 | shr rbx, 3 22 | sub rbx, 1 23 | %endmacro 24 | 25 | %macro _rdepth 0 26 | _ current_thread_raw_rp0 27 | sub rbx, rsp 28 | shr rbx, 3 29 | %endmacro 30 | -------------------------------------------------------------------------------- /feral/editorx.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feral-config 18 | 19 | empty 20 | 21 | constant: standalone? nil ; 22 | 23 | constant: winui? win64? have-winui? and ; 24 | constant: gtkui? linux? have-gtkui? and ; 25 | 26 | constant: termui? winui? gtkui? or not ; 27 | 28 | feline-home "feral" path-append "feral-main.feline" path-append load 29 | -------------------------------------------------------------------------------- /feral/mini.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-config feral-loader feline ; 17 | in: user 18 | 19 | "mini" delete-vocab 20 | 21 | in: mini 22 | 23 | winui? gtkui? or [ "minibuffer-common.feline" load-feral-source-file ] when 24 | 25 | { 26 | { [ winui? ] [ "winui-minibuffer.feline" ] } 27 | { [ gtkui? ] [ "gtkui-minibuffer.feline" ] } 28 | { [ termui? ] [ "termui-minibuffer.feline" ] } 29 | } cond load-feral-source-file 30 | -------------------------------------------------------------------------------- /src/chars.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feline 18 | 19 | private 20 | 21 | global bits 22 | 23 | : init 24 | 128 make-bit-array bits! 25 | "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" 26 | [ char-code bits set-bit ] each ; 27 | 28 | init 29 | 30 | forget init 31 | 32 | public 33 | 34 | : alphanumeric? 35 | dup char-code bits bit-array-nth-unsafe // -> char bit 36 | 0? [ nil nip ] when ; 37 | -------------------------------------------------------------------------------- /src/sequences.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feline 18 | 19 | : ?nth // n seq -> element/nil 20 | ?bounds [ nth-unsafe ] when* ; 21 | 22 | : ?first // seq -> element/nil 23 | 0 swap ?nth ; 24 | 25 | : empty? // seq/nil -> ? 26 | [ length 0? ] [ true ] if* ; 27 | 28 | : suffix! // seq element -> seq 29 | over push ; 30 | -------------------------------------------------------------------------------- /src/testdata/LICENSE: -------------------------------------------------------------------------------- 1 | The following license covers testregex.c and all associated test data. 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a 4 | copy of THIS SOFTWARE FILE (the "Software"), to deal in the Software 5 | without restriction, including without limitation the rights to use, 6 | copy, modify, merge, publish, distribute, and/or sell copies of the 7 | Software, and to permit persons to whom the Software is furnished to do 8 | so, subject to the following disclaimer: 9 | 10 | THIS SOFTWARE IS PROVIDED BY AT&T ``AS IS'' AND ANY EXPRESS OR IMPLIED 11 | WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 12 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 13 | IN NO EVENT SHALL AT&T BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 14 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 15 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 16 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 17 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 18 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 19 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 20 | -------------------------------------------------------------------------------- /feral/ansi-color.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2019 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: ansi-color 18 | 19 | : rgb-foreground-prefix // r g b -> string 20 | "\e[38;2;%d;%d;%dm" format ; 21 | 22 | : rgb-background-prefix // r g b -> string 23 | "\e[48;2;%d;%d;%dm" format ; 24 | 25 | : rgb-foreground // r g b -> void 26 | rgb-foreground-prefix write-string-escaped ; 27 | 28 | : rgb-background // r g b -> void 29 | rgb-background-prefix write-string-escaped ; 30 | -------------------------------------------------------------------------------- /feral/keymaps.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2017-2019 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-config feral-loader feline ; 17 | in: keymaps 18 | 19 | private 20 | 21 | global global-map 22 | 23 | : lookup-key // key -> symbol/nil 24 | global-map at ; 25 | 26 | winui? gtkui? or [ "minibuffer-keymap.feline" load-feral-source-file ] when 27 | 28 | { 29 | { [ winui? ] [ "winui-keymaps.feline" ] } 30 | { [ gtkui? ] [ "gtkui-keymaps.feline" ] } 31 | { [ termui? ] [ "termui-keymaps.feline" ] } 32 | } cond load-feral-source-file 33 | -------------------------------------------------------------------------------- /CREDITS: -------------------------------------------------------------------------------- 1 | Feline uses ideas and code from the Factor programming language 2 | (http://factorcode.org). 3 | 4 | Factor is distributed under the following license: 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, 17 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 18 | FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 19 | DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 20 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 21 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; 22 | OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 23 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 24 | OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 25 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /src/declare.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline accessors ; 17 | in: feline 18 | 19 | private 20 | 21 | "declared-type" constant declared-type-key 22 | 23 | public 24 | 25 | : declare // array -> void 26 | array-?last as-type type-typecode verify-typecode ; 27 | 28 | syntax: declare: 29 | must-parse-token 30 | find-name [ new-symbol-in-current-vocab ] unless verify-symbol :> sym 31 | ";" parse-until :> vec 32 | 33 | vec vector-length 1 eq? [ 34 | vec first as-type declared-type-key sym symbol-set-prop 35 | ] when 36 | ; 37 | 38 | : symbol-declared-type // symbol -> type/nil 39 | declared-type-key swap symbol-prop ; 40 | -------------------------------------------------------------------------------- /feral/feral-key.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feral-key 18 | 19 | constant: alt-bit 0x01 ; 20 | constant: ctrl-bit 0x02 ; 21 | constant: shift-bit 0x04 ; 22 | 23 | constant: alt-mask alt-bit 16 lshift ; 24 | constant: ctrl-mask ctrl-bit 16 lshift ; 25 | constant: shift-mask shift-bit 16 lshift ; 26 | 27 | : alt alt-mask bitor ; 28 | : ctrl ctrl-mask bitor ; 29 | : shift shift-mask bitor ; 30 | 31 | : modifiers 16 rshift 0x7 bitand ; 32 | 33 | use: feral-loader 34 | 35 | feral-config:winui? [ "winui-key.feline" load-feral-source-file ] when 36 | feral-config:gtkui? [ "gtkui-key.feline" load-feral-source-file ] when 37 | feral-config:termui? [ "termui-key.feline" load-feral-source-file ] when 38 | -------------------------------------------------------------------------------- /src/tokenize.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feline 18 | 19 | : tokenize ( s ) // string -> vector/nil 20 | // Splits the given string into a vector of whitespace-delimited tokens. 21 | // "this is a test" tokenize -> vector{ "this" "is" "a" "test" } 22 | 23 | 0 s string-skip-whitespace !> start 24 | start nil? [ nil ] ?return 25 | 26 | 8 make-vector :> v 27 | 28 | [ start ] 29 | [ 30 | start s string-skip-to-whitespace 31 | [ 32 | start over s string-substring v push 33 | s string-skip-whitespace start! 34 | ] [ 35 | start s string-length s string-substring v push 36 | nil start! 37 | ] if* 38 | ] while 39 | 40 | v ; 41 | -------------------------------------------------------------------------------- /feral/feral-hooks.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline accessors feral-config ; 17 | in: feral-hooks 18 | 19 | : add-hook ( callable hook ) // callable symbol -> void 20 | hook symbol-value [ 21 | 1 make-vector hook symbol-set-value 22 | ] unless 23 | hook symbol-value verify-vector :> hooks 24 | callable hooks vector-adjoin ; 25 | 26 | : remove-hook ( callable hook ) // callable symbol -> void 27 | hook nil? ?exit 28 | hook symbol-value vector? [ 29 | callable swap vector-remove! drop 30 | ] when* ; 31 | 32 | : run-hooks ( hook ) // hook -> void 33 | hook nil? ?exit 34 | hook symbol-value vector? [ 35 | [ call ] each 36 | ] when* ; 37 | 38 | global exit-feral-hook 39 | -------------------------------------------------------------------------------- /feral/feral-config.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feral-config 18 | 19 | // The location of the local copy of the Feline source repository. 20 | global feline-repository 21 | 22 | // This is the default. The user can specify a different repository path 23 | // in .feral.d/init.feline. 24 | feline-home feline-repository! 25 | 26 | : get-feline-repository 27 | feline-repository ; 28 | 29 | : set-feline-repository 30 | feline-repository! ; 31 | 32 | global source-path 33 | 34 | // This is the default. The user can specify a different source path in 35 | // .feral.d/init.feline. 36 | { "src" "feral" "benchmarks" } [ feline-home swap path-append ] map source-path! 37 | 38 | : get-source-path 39 | source-path ; 40 | 41 | : set-source-path 42 | source-path! ; 43 | -------------------------------------------------------------------------------- /src/dump.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: dump 18 | 19 | : .2 // ub -> 20 | >hex dup length 2 < [ '0' write-char ] when write-string ; 21 | 22 | : dump-line // addr len -> 23 | ?nl 24 | over >hex dup length 12 swap - spaces write-string 2 spaces 25 | [ [ c@ .2 space ] each ] keep 26 | dup length 16 swap - 3 * 1 + spaces 27 | [ c@ code-char dup printable-char? [ drop '.' ] unless write-char ] each ; 28 | 29 | using: dump feline ; 30 | in: feline 31 | 32 | : dump // addr len -> 33 | ?nl 15 spaces 34 | over 16 [ 15 bitand >hex write-string 2 spaces ] each 35 | [ dup 16 > not ] [ over 16 dump-line 16 - swap 16 + swap ] until 36 | dump-line ; 37 | -------------------------------------------------------------------------------- /src/math.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2017 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; ### sin 19 | code math_sin, 'sin' ; x -- y 20 | _dup 21 | _ object_raw_typecode 22 | mov rax, rbx 23 | poprbx 24 | 25 | cmp rax, TYPECODE_FIXNUM 26 | je .1 27 | cmp rax, TYPECODE_INT64 28 | je .2 29 | cmp rax, TYPECODE_FLOAT 30 | je .3 31 | 32 | _ error_not_number 33 | _return 34 | 35 | .1: 36 | ; fixnum 37 | _ fixnum_to_float 38 | jmp .3 39 | 40 | .2: 41 | ; int64 42 | _ int64_to_float 43 | ; fall through... 44 | .3: 45 | ; float 46 | _handle_to_object_unsafe 47 | mov arg0_register, rbx 48 | xcall c_float_sin 49 | mov rbx, rax 50 | _ new_handle 51 | next 52 | endcode 53 | -------------------------------------------------------------------------------- /feral/completion.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline accessors ; 17 | in: completion 18 | 19 | empty 20 | 21 | private 22 | 23 | tuple: completion 24 | prefix 25 | index 26 | strings ; 27 | 28 | public 29 | 30 | global current-completion 31 | 32 | : initialize-completion // prefix strings 33 | completion make-instance :> c 34 | c strings<< 35 | c prefix<< 36 | 0 c index<< 37 | c current-completion! ; 38 | 39 | : reset-completion 40 | nil current-completion! ; 41 | 42 | : next-completion // void -> string/nil 43 | current-completion :> c 44 | c nil? [ nil ] ?return 45 | c strings>> empty? [ nil ] ?return 46 | 47 | c index>> c strings>> length < assert 48 | c index>> c strings>> nth // -> string 49 | 50 | c index>> 1+ :> new-index 51 | new-index c strings>> length < [ new-index ] [ 0 ] if c index<< ; 52 | -------------------------------------------------------------------------------- /src/backtrace.c: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2015-2019 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | #include // memset 17 | 18 | #include "feline.h" 19 | 20 | static cell saved_backtrace_array[32]; 21 | static cell saved_backtrace_size; 22 | 23 | cell * c_get_saved_backtrace_array (void) 24 | { 25 | return saved_backtrace_array; 26 | } 27 | 28 | cell c_get_saved_backtrace_size (void) 29 | { 30 | return saved_backtrace_size; 31 | } 32 | 33 | // thread.asm 34 | cell current_thread_raw_rp0_rax (void); 35 | 36 | void c_save_backtrace (cell rip, cell rsp) 37 | { 38 | memset (saved_backtrace_array, 0, sizeof (saved_backtrace_array)); 39 | saved_backtrace_array[0] = rip; 40 | int i = 1; 41 | cell * rp0 = (cell *) current_thread_raw_rp0_rax (); 42 | for (cell * p = (cell *) rsp; p < rp0; ++p) 43 | { 44 | saved_backtrace_array[i++] = *p; 45 | if (i >= sizeof (saved_backtrace_array) / sizeof (cell)) 46 | break; 47 | } 48 | saved_backtrace_size = i; 49 | } 50 | -------------------------------------------------------------------------------- /feral/directories.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2019 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: directories 18 | 19 | empty 20 | 21 | global feral-directory // ~/.feral.d 22 | global feral-history-directory // ~/.feral.d/history 23 | global feral-temp-directory // ~/.feral.d/temp 24 | 25 | : initialize-directories 26 | user-home ".feral.d" path-append feral-directory! 27 | feral-directory "history" path-append feral-history-directory! 28 | feral-directory "temp" path-append feral-temp-directory! 29 | 30 | feral-directory directory? [ 31 | feral-directory make-directory 32 | ] unless 33 | 34 | feral-history-directory directory? [ 35 | feral-history-directory make-directory 36 | ] unless 37 | 38 | feral-temp-directory directory? [ 39 | feral-temp-directory make-directory 40 | ] unless ; 41 | 42 | initialize-directories 43 | 44 | : get-temporary-filename // void -> string 45 | feral-temp-directory 46 | nano-count fixnum>uint64 uint64>string 47 | path-append ; 48 | -------------------------------------------------------------------------------- /feral/feral.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2017-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feral-config 18 | 19 | empty 20 | 21 | constant: standalone? true ; 22 | 23 | constant: winui? win64? have-winui? and ; 24 | constant: gtkui? linux? have-gtkui? and ; 25 | 26 | constant: termui? winui? gtkui? or not ; 27 | 28 | feline-home "feral" path-append "feral-main.feline" path-append load 29 | 30 | in: feral 31 | 32 | : go 33 | feral-core:load-feral-init-file 34 | 35 | "editor" use-vocab 36 | 37 | // args[0] is full path to Feline executable 38 | // args[1] is full path to feral.feline 39 | args length :> len 40 | len 2 eq? [ editor:edit-current-directory bye ] ?return 41 | 42 | // more than 2 args 43 | len 3 eq? [ args third editor:edit-file bye ] ?return 44 | 45 | len 4 >= [ 46 | args third first '+' eq? [ 47 | 1 args third string-tail string>number [ 48 | // -> n 49 | args fourth editor:edit-file/2 bye 50 | ] when* 51 | ] when 52 | ] when 53 | 54 | ?nl "Too many command line arguments" print bye ; 55 | 56 | go 57 | -------------------------------------------------------------------------------- /feral/termui-minibuffer.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline accept-string ; 17 | in: mini 18 | 19 | feral-config:termui? assert 20 | 21 | private 22 | 23 | global completion-provider 24 | 25 | public 26 | 27 | : set-completion-provider completion-provider! ; 28 | 29 | : status-y // -> n 30 | terminal-rows 2 - ; 31 | 32 | : message-y // -> n 33 | terminal-rows 1- ; 34 | 35 | : message // string -> 36 | 0 message-y at-xy write-string ; 37 | 38 | ' message is feral-core:message 39 | 40 | : clear-message hide-cursor 0 message-y at-xy clear-to-eol ; 41 | 42 | ' clear-message is feral-core:clear-message 43 | 44 | : show-message-briefly // string -> void 45 | // REVIEW 46 | drop ; 47 | 48 | : minibuffer-accept-string // prompt -> string 49 | 0 message-y at-xy 50 | accept-string 51 | clear-message ; 52 | 53 | : minibuffer-accept-string/2 // prompt default -> string 54 | 0 message-y at-xy 55 | accept-string/2 56 | clear-message ; 57 | -------------------------------------------------------------------------------- /feral/quit.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline feral-core mini feral-hooks ; 17 | in: editor 18 | 19 | feral-config:winui? #if 20 | 21 | : exit-feral 22 | ' exit-feral-hook run-hooks 23 | winui-exit 24 | current-thread primordial-thread eq? [ bye ] when ; 25 | 26 | #endif 27 | 28 | feral-config:gtkui? #if 29 | 30 | : exit-feral 31 | ' exit-feral-hook run-hooks 32 | gtkui-exit ; 33 | 34 | #endif 35 | 36 | feral-config:termui? #if 37 | 38 | var done? 39 | 40 | : exit-feral 41 | ' exit-feral-hook run-hooks 42 | true done?! ; 43 | 44 | #endif 45 | 46 | use: accessors 47 | 48 | : do-quit 49 | local buf 50 | buffer-list [ 51 | buf! 52 | buf filename>> [ 53 | buf dot>> line>> number>> 1+ add-recent-file 54 | ] when* 55 | ] each 56 | 57 | buffer-list [ buffer-modified? ] count :> n 58 | 59 | n 0? [ 60 | exit-feral 61 | ] [ 62 | n dup 1 > "s" "" ? 63 | "Really exit with %s modified buffer%s? (yes or no) " format 64 | minibuffer-accept-string 65 | "yes" = [ exit-feral ] when 66 | ] if ; 67 | -------------------------------------------------------------------------------- /benchmarks/xorshift128+.feline: -------------------------------------------------------------------------------- 1 | using: feline ; 2 | in: xorshift128+ 3 | 4 | var var0 // state0 5 | var var1 // state1 6 | 7 | : xorshift128+ 8 | var0 :> s1! 9 | var1 :> s0! 10 | s0 var0! 11 | s1 23 lshift s1 bitxor s1! 12 | s1 17 rshift s1 bitxor s1! 13 | s1 s0 bitxor s1! 14 | s0 26 rshift s1 bitxor s1! 15 | s1 var1! ; 16 | 17 | : test-vars 18 | gc 19 | 20 | 1 var0! 21 | 2 var1! 22 | 23 | [ 10000000 [ xorshift128+ ] times ] time 24 | 25 | "state0 = " write var0 . 26 | "state1 = " write var1 . ; 27 | 28 | // state0 = 2116950370223064412 29 | // state1 = 13984883008063501915 30 | 31 | // 2 threads 32 | : test2 33 | [ test-vars ] make-thread thread-create 34 | test-vars ; 35 | 36 | // 3 threads 37 | : test3 38 | [ test-vars ] make-thread thread-create 39 | [ test-vars ] make-thread thread-create 40 | test-vars ; 41 | 42 | global global0 43 | global global1 44 | 45 | : xorshift128+-globals 46 | global0 :> s1! 47 | global1 :> s0! 48 | s0 global0! 49 | s1 23 lshift s1 bitxor s1! 50 | s1 17 rshift s1 bitxor s1! 51 | s1 s0 bitxor s1! 52 | s0 26 rshift s1 bitxor s1! 53 | s1 global1! ; 54 | 55 | : test-globals 56 | gc 57 | 58 | 1 global0! 59 | 2 global1! 60 | 61 | [ 10000000 [ xorshift128+-globals ] times ] time 62 | "state0 = " write global0 . 63 | "state1 = " write global1 . ; 64 | 65 | : xorshift128+-locals-only 66 | :> s0! 67 | :> s1! 68 | 69 | s1 23 lshift s1 bitxor s1! 70 | s1 17 rshift s1 bitxor s1! 71 | s1 s0 bitxor s1! 72 | s0 26 rshift s1 bitxor s1! 73 | 74 | s0 s1 ; 75 | 76 | : test-locals-only 77 | gc 78 | 1 2 [ 10000000 [ xorshift128+-locals-only ] times ] time 79 | swap 80 | "state0 = " write . 81 | "state1 = " write . ; 82 | -------------------------------------------------------------------------------- /feral/logging.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline feral-hooks ; 17 | in: logging 18 | 19 | empty 20 | 21 | private 22 | 23 | global log-stream 24 | 25 | : close-log // void -> void 26 | log-stream [ close nil log-stream! ] when* ; 27 | 28 | : initialize-logging // void -> void 29 | ' close-log ' exit-feral-hook add-hook 30 | user-home "feral.log" path-append file-create-write log-stream! ; 31 | 32 | : stamp // void -> void 33 | log-stream [ 34 | dup stream-?nl 35 | date-time " " + swap file-output-stream-write-string 36 | ] when* ; 37 | 38 | public 39 | 40 | : log // string -> void 41 | log-stream [ initialize-logging ] unless 42 | 43 | stamp 44 | 45 | log-stream { 46 | [ file-output-stream-write-string ] 47 | [ file-output-stream-nl ] 48 | [ file-output-stream-flush ] 49 | } cleave ; 50 | 51 | : with-output-to-log // quotation -> void 52 | log-stream [ initialize-logging ] unless 53 | 54 | [ 55 | log-stream standard-output set 56 | stamp 57 | call 58 | ] with-dynamic-scope ; 59 | -------------------------------------------------------------------------------- /src/boolean.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2017-2020 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; ### boolean? 19 | code boolean?, 'boolean?' ; x -> ? 20 | cmp rbx, NIL 21 | je .yes 22 | cmp rbx, TRUE 23 | je .yes 24 | mov ebx, NIL 25 | next 26 | .yes: 27 | mov ebx, TRUE 28 | next 29 | endcode 30 | 31 | ; ### boolean-equal? 32 | code boolean_equal?, 'boolean-equal?' ; x y -> ? 33 | cmp rbx, NIL 34 | je .1 35 | cmp rbx, TRUE 36 | jne .no 37 | .1: 38 | cmp rbx, [rbp] 39 | jne .no 40 | _nip 41 | mov ebx, TRUE 42 | next 43 | .no: 44 | _nip 45 | mov ebx, NIL 46 | next 47 | endcode 48 | 49 | ; ### >boolean 50 | code to_boolean, '>boolean' ; x -> ? 51 | mov eax, TRUE 52 | cmp rbx, NIL 53 | cmovne ebx, eax 54 | next 55 | endcode 56 | 57 | ; ### boolean->string 58 | code boolean_to_string, 'boolean->string' ; boolean -> string 59 | cmp rbx, NIL 60 | jne .1 61 | _drop 62 | _quote "nil" 63 | next 64 | .1: 65 | cmp rbx, TRUE 66 | jne error_not_boolean 67 | _drop 68 | _quote "true" 69 | next 70 | endcode 71 | -------------------------------------------------------------------------------- /src/control.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2019 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: control 18 | 19 | empty 20 | 21 | public 22 | 23 | global ignore-level 0 ignore-level! 24 | 25 | : ignoring? ignore-level 0 > ; 26 | 27 | : stop-ignoring 0 ignore-level! ; 28 | 29 | private 30 | 31 | : process-next-token 32 | must-parse-token :> token 33 | 34 | { 35 | { [ token "#if" = ] [ ignore-level 1+ ignore-level! ] } 36 | { [ token "#endif" = ] [ ignore-level 1- ignore-level! ] } 37 | { [ token "#else" = ] [ ignore-level 1 = [ stop-ignoring ] when ] } 38 | [ ] // otherwise, nothing to do 39 | } cond ; 40 | 41 | public 42 | 43 | : start-ignoring 44 | 1 ignore-level! 45 | [ ignoring? ] [ process-next-token ] while ; 46 | 47 | using: feline control ; 48 | in: feline 49 | 50 | public 51 | 52 | syntax: #if // ? -> 53 | [ start-ignoring ] unless ; 54 | 55 | syntax: #else 56 | ignore-level { 57 | { 0 [ start-ignoring ] } 58 | { 1 [ stop-ignoring ] } 59 | [ drop ] 60 | } case ; 61 | 62 | syntax: #endif ignoring? [ ignore-level 1- ignore-level! ] when ; 63 | 64 | syntax: #ifdef 65 | must-parse-token 66 | find-name nip 67 | postpone: #if ; 68 | 69 | syntax: #ifndef 70 | must-parse-token 71 | find-name nip not 72 | postpone: #if ; 73 | -------------------------------------------------------------------------------- /src/random.c: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | #include 17 | 18 | // splitmix64 19 | // Written in 2015 by Sebastiano Vigna (vigna@acm.org). 20 | // http://xoroshiro.di.unimi.it/splitmix64.c 21 | // public domain 22 | 23 | static uint64_t x; 24 | 25 | static uint64_t splitmix64_next() 26 | { 27 | uint64_t z = (x += 0x9E3779B97F4A7C15); 28 | z = (z ^ (z >> 30)) * 0xBF58476D1CE4E5B9; 29 | z = (z ^ (z >> 27)) * 0x94D049BB133111EB; 30 | return z ^ (z >> 31); 31 | } 32 | 33 | // xoroshiro128+ 34 | // Written in 2016 by David Blackman and Sebastiano Vigna (vigna@acm.org). 35 | // http://xoroshiro.di.unimi.it/xoroshiro128plus.c 36 | // public domain 37 | 38 | static uint64_t state0, state1; 39 | 40 | static inline uint64_t rotl(const uint64_t s, int k) 41 | { 42 | return (s << k) | (s >> (64 - k)); 43 | } 44 | 45 | static inline uint64_t xoroshiro128plus_next() 46 | { 47 | const uint64_t s0 = state0; 48 | uint64_t s1 = state1; 49 | const uint64_t result = s0 + s1; 50 | 51 | s1 ^= s0; 52 | state0 = rotl(s0, 55) ^ s1 ^ (s1 << 14); 53 | state1 = rotl(s1, 36); 54 | 55 | return result; 56 | } 57 | 58 | 59 | // Feline 60 | void c_seed_random(uint64_t seed) 61 | { 62 | x = seed; 63 | state0 = splitmix64_next(); 64 | state1 = splitmix64_next(); 65 | } 66 | 67 | uint64_t c_random() 68 | { 69 | return xoroshiro128plus_next(); 70 | } 71 | -------------------------------------------------------------------------------- /feral/kill-ring.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2021 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: kill-ring 18 | 19 | global kill-list // -> vector 20 | global kill-list-next // -> fixnum/nil 21 | global last-paste // -> string/nil 22 | 23 | : initialize-kill-ring 24 | 16 make-vector kill-list! 25 | nil kill-list-next! ; 26 | 27 | initialize-kill-ring 28 | 29 | : maybe-promote-last-paste 30 | last-paste [ 31 | kill-list vector-adjoin 32 | nil last-paste! 33 | ] when* ; 34 | 35 | : last-kill // void -> string/nil 36 | kill-list empty? [ nil ] ?return 37 | 38 | kill-list length 1- :> n 39 | 40 | n kill-list nth // -> string 41 | 42 | n 0> n 1- nil ? kill-list-next! ; 43 | 44 | : next-kill 45 | kill-list empty? [ nil ] ?return 46 | 47 | kill-list-next nil? [ nil ] ?return 48 | 49 | kill-list-next kill-list nth // -> string 50 | 51 | dup last-paste! 52 | 53 | kill-list-next 0> [ 54 | kill-list-next 1- kill-list-next! 55 | ] [ 56 | // wrap around 57 | kill-list length 1- kill-list-next! 58 | ] if ; 59 | 60 | : append-kill // string -> void 61 | maybe-promote-last-paste 62 | [ kill-list vector-push ] [ set-clipboard-text drop ] bi ; 63 | -------------------------------------------------------------------------------- /src/control-test.feline: -------------------------------------------------------------------------------- 1 | using: feline control ; 2 | in: control-test 3 | 4 | empty 5 | 6 | clear 7 | 8 | depth zero? assert-true 9 | ignore-level zero? assert-true 10 | 11 | t #if 12 | depth zero? assert-true 13 | ignore-level zero? assert-true 14 | #endif 15 | 16 | f #if 17 | assert-false 18 | #else 19 | depth zero? assert-true 20 | ignore-level zero? assert-true 21 | #endif 22 | 23 | ignore-level zero? assert-true 24 | 25 | f #if 26 | assert-false 27 | 28 | t #if 29 | assert-false 30 | #else 31 | assert-false 32 | #endif 33 | assert-false 34 | 35 | #else 36 | depth zero? assert-true 37 | ignore-level zero? assert-true 38 | #endif 39 | 40 | t #if 41 | ignore-level zero? assert-true 42 | 43 | f #if 44 | assert-false 45 | #else 46 | depth zero? assert-true 47 | ignore-level zero? assert-true 48 | #endif 49 | 50 | depth zero? assert-true 51 | ignore-level zero? assert-true 52 | #else 53 | assert-false 54 | #endif 55 | 56 | depth zero? assert-true 57 | ignore-level zero? assert-true 58 | 59 | // control-test:raccoon is not defined 60 | test: control-test-1 61 | #ifdef control-test:raccoon 62 | "yes raccoon" 63 | #else 64 | "no raccoon" 65 | #endif 66 | 67 | "no raccoon" assert= 68 | 69 | depth zero? assert-true 70 | 71 | #ifndef control-test:raccoon 72 | "no raccoon" 73 | #else 74 | "yes raccoon" 75 | #endif 76 | 77 | "no raccoon" assert= 78 | 79 | depth zero? assert-true ; 80 | 81 | control-test-1 82 | 83 | symbol: baboon 84 | 85 | // control-test:baboon is defined 86 | test: control-test-2 87 | #ifdef control-test:baboon 88 | "yes baboon" 89 | #else 90 | "no baboon" 91 | #endif 92 | 93 | "yes baboon" assert= 94 | 95 | depth zero? assert-true 96 | 97 | #ifndef control-test:baboon 98 | "no baboon" 99 | #else 100 | "yes baboon" 101 | #endif 102 | 103 | "yes baboon" assert= 104 | 105 | depth zero? assert-true ; 106 | 107 | control-test-2 108 | 109 | ?nl "Reached end of control-test.feline" write-string 110 | -------------------------------------------------------------------------------- /src/syntax.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feline 18 | 19 | private 20 | 21 | : make-global ( name ) // string -> void 22 | 23 | name new-symbol-in-current-vocab :> reader 24 | 25 | reader { 26 | [ symbol-set-global-bit ] 27 | [ ' symbol-value 2quotation ] 28 | [ symbol-set-def ] 29 | [ compile-word ] 30 | } cleave 31 | 32 | name "!" + new-symbol-in-current-vocab 33 | { 34 | [ drop reader ' symbol-set-value 2quotation ] 35 | [ symbol-set-def ] 36 | [ compile-word ] 37 | } cleave ; 38 | 39 | : make-var ( name ) // string -> void 40 | 41 | name new-symbol-in-current-vocab :> reader 42 | 43 | reader { 44 | [ symbol-set-thread-local-bit ] 45 | [ ' current-thread-local-get 2quotation ] 46 | [ symbol-set-def ] 47 | [ compile-word ] 48 | } cleave 49 | 50 | name "!" + new-symbol-in-current-vocab { 51 | [ drop reader ' current-thread-local-set 2quotation ] 52 | [ symbol-set-def ] 53 | [ compile-word ] 54 | } cleave ; 55 | 56 | public 57 | 58 | syntax: global must-parse-token make-global ; 59 | 60 | syntax: var must-parse-token make-var ; 61 | 62 | syntax: constant // x -> void 63 | parse-name 64 | swap 1quotation over symbol-set-def compile-word ; 65 | -------------------------------------------------------------------------------- /src/unit-test.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: unit-test 18 | 19 | empty 20 | 21 | private 22 | 23 | var location 24 | var expected 25 | var quot 26 | var got 27 | var saved 28 | 29 | : do-unit-test // sequence quotation location -> void 30 | location! quot! expected! 31 | get-datastack saved! 32 | quot call 33 | get-datastack got! 34 | saved set-datastack 35 | expected got sequence= [ 36 | location set-error-location 37 | expected got "ERROR: expected %s, got %s." format error 38 | ] unless ; 39 | 40 | public 41 | 42 | syntax: unit-test 43 | in-definition? get [ 44 | current-lexer-location accum-push 45 | ' do-unit-test accum-push 46 | ] [ 47 | current-lexer-location do-unit-test 48 | ] if ; 49 | 50 | using: feline ; 51 | in: feline 52 | 53 | global run-tests-when-defined? 54 | 55 | syntax: test: 56 | parse-name :> sym 57 | make-quotation current-quotation! 58 | parse-definition :> vec 59 | ' ?nl 0 vec vector-insert-nth 60 | sym symbol-name 1 vec vector-insert-nth 61 | ' write-string 2 vec vector-insert-nth 62 | vec vector->array current-quotation quotation-set-array 63 | current-quotation sym symbol-set-def 64 | locals-count sym symbol-set-locals-count 65 | nil current-quotation! 66 | sym compile-word 67 | run-tests-when-defined? [ sym call-symbol ] when ; 68 | -------------------------------------------------------------------------------- /feral/gtkui-display.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2017-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-core feline accessors segments feral-colors ; 17 | in: editor 18 | 19 | feral-config:gtkui? assert 20 | 21 | : update-caret-pos 22 | dot-column 23 | dot-line-number top-line-number - 24 | textview-set-caret-pos ; 25 | 26 | : update-mode-line mode-line-text modeline-set-text ; 27 | 28 | : repaint-internal 29 | lock-current-buffer 30 | top-line !> line 31 | 0 !> row 32 | [ line row textview-rows < and ] [ 33 | line row repaint-line 34 | row 1+ row! line next>> line! 35 | ] while 36 | nil repaint?! 37 | unlock-current-buffer ; 38 | 39 | : repaint 40 | current-buffer minibuffer? [ 41 | minibuffer parent>> current-buffer! 42 | repaint-internal 43 | minibuffer current-buffer! 44 | ] [ 45 | repaint-internal 46 | ] if ; 47 | 48 | : update-display-internal 49 | gtkui-textview-invalidate 50 | update-caret-pos 51 | update-mode-line ; 52 | 53 | : update-display 54 | [ update-display-internal ] [ 55 | last-error string? [ 56 | last-error 57 | [ feral-config:termui? [ print ] unless ] 58 | [ message ] 59 | [ logging:log ] 60 | tri 61 | ] when 62 | [ print-backtrace ] logging:with-output-to-log 63 | ] recover ; 64 | 65 | : request-update-display 66 | // REVIEW 67 | update-display ; 68 | -------------------------------------------------------------------------------- /feral/segments.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2019 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline accessors feral-core ; 17 | in: segments 18 | 19 | empty 20 | 21 | tuple: segment 22 | text 23 | start 24 | format ; 25 | 26 | : make-segment ( text start ) 27 | segment make-instance :> segment 28 | text segment text<< 29 | start segment start<< 30 | segment ; 31 | 32 | : make-segment/3 ( text start format ) 33 | segment make-instance :> segment 34 | text segment text<< 35 | start segment start<< 36 | format segment format<< 37 | segment ; 38 | 39 | method: segment length // segment -> length 40 | text>> string-length ; 41 | 42 | method: segment begin-offset // segment -> offset 43 | start>> ; 44 | 45 | method: segment end-offset // segment -> offset 46 | dup start>> swap length + ; 47 | 48 | : in-segment? ( n segment ) // n segment -> ? 49 | n segment start>> >= [ 50 | n segment start>> segment length + < 51 | ] [ nil ] if ; 52 | 53 | : split-segment ( segment index ) // segment index -> seg1 seg2 54 | segment text>> :> text 55 | segment format>> :> format 56 | segment start>> :> start 57 | 58 | index text string-head start format make-segment/3 59 | index text string-tail start index + format make-segment/3 ; 60 | 61 | : detabbed-text-length ( segments ) // segments -> fixnum 62 | segments length 0? [ 0 ] ?return 63 | segments last [ start>> ] [ text>> string-length ] bi + ; 64 | -------------------------------------------------------------------------------- /feral/minibuffer-common.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-core feline accessors ; 17 | in: mini 18 | 19 | feral-config:winui? feral-config:gtkui? or assert 20 | 21 | private 22 | 23 | global minibuffer-contents 24 | 25 | global prompt 26 | 27 | global minibuffer-keymap 28 | 29 | global completion-provider 30 | 31 | global minibuffer-mode 32 | 33 | : minibuffer-mode-identifier-char? // char -> ? 34 | '\s' neq? ; 35 | 36 | : initialize-minibuffer-mode 37 | mode make-instance :> m 38 | "Minibuffer" m name<< 39 | ' minibuffer-mode-identifier-char? m identifier-char-function<< 40 | m minibuffer-mode! ; 41 | 42 | initialize-minibuffer-mode 43 | 44 | : create-minibuffer 45 | minibuffer nil? assert 46 | make-buffer minibuffer! 47 | minibuffer-mode minibuffer mode<< 48 | "" 0 make-line/2 49 | [ minibuffer buffer-append-line ] 50 | [ 0 make-position minibuffer dot<< ] 51 | bi 52 | minibuffer dot>> line>> minibuffer top-line<< ; 53 | 54 | create-minibuffer 55 | 56 | public 57 | 58 | : minibuffer-get-text // void -> string 59 | minibuffer dot>> line>> text>> "" or ; 60 | 61 | : minibuffer-user-text // void -> string 62 | minibuffer-get-text :> s 63 | s length prompt length > [ prompt length s string-tail ] [ "" ] if ; 64 | 65 | : minibuffer-prompt // void -> string/nil 66 | prompt ; 67 | 68 | : minibuffer-set-prompt // string/nil -> void 69 | prompt! ; 70 | 71 | : set-completion-provider completion-provider! ; 72 | -------------------------------------------------------------------------------- /src/strings.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feline 18 | 19 | private: string-trim-head-internal ( s ) // string -> string 20 | s [ whitespace? not ] find // -> index/nil element/nil 21 | [ s string-tail ] [ drop "" ] if ; 22 | 23 | : string-trim-head ( s ) // string -> string 24 | s string-length 0? [ s ] ?return 25 | s string-first-char whitespace? not [ s ] ?return 26 | s string-trim-head-internal ; 27 | 28 | private: string-trim-tail-internal ( s ) // string -> string 29 | s string-length 1- s [ whitespace? not ] find-last-from // -> index/nil element/nil 30 | [ 1+ s string-head ] [ drop "" ] if ; 31 | 32 | : string-trim-tail ( s ) // string -> string 33 | s string-length 0? [ s ] ?return 34 | s string-last-char whitespace? not [ s ] ?return 35 | s string-trim-tail-internal ; 36 | 37 | : string-trim // string -> string 38 | !> s 39 | s string-length 0? [ s ] ?return 40 | s string-first-char whitespace? [ s string-trim-head-internal s! ] when 41 | s string-length 0? [ s ] ?return 42 | s string-last-char whitespace? [ s string-trim-tail-internal s! ] when 43 | s ; 44 | 45 | : string-downcase ( s ) // string -> string 46 | s string-length make-sbuf :> sb 47 | s [ char-downcase sb sbuf-push-unsafe ] each 48 | sb sbuf->string ; 49 | 50 | : string-upcase ( s ) // string -> string 51 | s string-length make-sbuf :> sb 52 | s [ char-upcase sb sbuf-push-unsafe ] each 53 | sb sbuf->string ; 54 | 55 | : pad-left ( c n s ) // char fixnum string -> string 56 | c char? assert 57 | s string-length :> len 58 | len n verify-index >= [ s ] ?return 59 | n len > assert 60 | n make-sbuf :> sb 61 | n len - [ c sb sbuf-push-unsafe ] times 62 | s sb sbuf-append-string 63 | sb sbuf->string ; 64 | -------------------------------------------------------------------------------- /src/debug.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2016-2018 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | asm_global debug_enabled, t_value 19 | 20 | ; ### +debug 21 | code debug_on, '+debug' 22 | mov qword [debug_enabled], t_value 23 | next 24 | endcode 25 | 26 | ; ### -debug 27 | code debug_off, '-debug' 28 | mov qword [debug_enabled], f_value 29 | next 30 | endcode 31 | 32 | ; ### debug0 33 | code debug0, 'debug0' ; string -- 34 | cmp qword [debug_enabled], f_value 35 | je .1 36 | _ ?nl 37 | _ write_string 38 | _ nl 39 | .1: 40 | next 41 | endcode 42 | 43 | %macro _debug0 1 44 | _quote %1 45 | _ debug0 46 | %endmacro 47 | 48 | ; ### debug1 49 | code debug1, 'debug1' ; string -- 50 | cmp qword [debug_enabled], f_value 51 | je .1 52 | _ ?nl 53 | _ write_string 54 | _write ": " 55 | _dup 56 | _ dot_object 57 | _return 58 | .1: 59 | _drop 60 | next 61 | endcode 62 | 63 | %macro _debug1 1 64 | _quote %1 65 | _ debug1 66 | %endmacro 67 | 68 | asm_global debug_print_lock_, 0 69 | 70 | ; ### debug-print 71 | code debug_print, 'debug-print' ; string -- 72 | 73 | mov eax, 1 74 | 75 | .lock: 76 | cmp byte [debug_print_lock_], 0 77 | jne .lock 78 | 79 | xchg eax, [debug_print_lock_] 80 | test eax, eax 81 | jnz .lock 82 | 83 | _ ?nl 84 | 85 | _ current_thread 86 | _ thread_debug_name 87 | _ write_string 88 | _quote ": " 89 | _ write_string 90 | 91 | _ write_string 92 | _ nl 93 | 94 | ; unlock 95 | mov byte [debug_print_lock_], 0 96 | 97 | next 98 | endcode 99 | -------------------------------------------------------------------------------- /src/backtrace.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2018 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feline 18 | 19 | : find-word-from-code-address ( x ) // tagged-code-address -> word/f 20 | all-words 21 | [ 22 | dup symbol-code-address swap symbol-code-size 23 | 2dup and 24 | [ over + 1- x -rot between? ] [ 2drop f ] if 25 | ] 26 | find nip ; 27 | 28 | : print-reg // string untagged -> 29 | swap write-string 30 | "0x" write-string 31 | untagged>hex write-string ; 32 | 33 | : print-saved-registers 34 | ?nl 35 | "Registers:" write-string nl 36 | 4 tab "RAX = " saved-rax print-reg 40 tab "R8 = " saved-r8 print-reg nl 37 | 4 tab "RBX = " saved-rbx print-reg 40 tab "R9 = " saved-r9 print-reg nl 38 | 4 tab "RCX = " saved-rcx print-reg 40 tab "R10 = " saved-r10 print-reg nl 39 | 4 tab "RDX = " saved-rdx print-reg 40 tab "R11 = " saved-r11 print-reg nl 40 | 4 tab "RSI = " saved-rsi print-reg 40 tab "R12 = " saved-r12 print-reg nl 41 | 4 tab "RDI = " saved-rdi print-reg 40 tab "R13 = " saved-r13 print-reg nl 42 | 4 tab "RBP = " saved-rbp print-reg 40 tab "R14 = " saved-r14 print-reg nl 43 | 4 tab "RSP = " saved-rsp print-reg 40 tab "R15 = " saved-r15 print-reg nl 44 | 4 tab "RIP = " saved-rip print-reg 40 tab "EFL = " saved-efl print-reg nl ; 45 | 46 | : format-address // untagged -> 47 | untagged>hex dup length 16 swap - spaces 48 | "0x" write-string 49 | write-string ; 50 | 51 | : format-word // tagged-code-address symbol -> 52 | dup symbol-name write-string 53 | symbol-code-address - 54 | space '+' write-char space fixnum>string write-string ; 55 | 56 | : print-backtrace 57 | ?nl "Backtrace:" write-string 58 | get-saved-backtrace 59 | nl 60 | [ 61 | dup format-address space 62 | tag-fixnum dup find-word-from-code-address [ format-word ] [ drop ] if* 63 | nl 64 | ] each ; 65 | 66 | : bt print-backtrace ; 67 | -------------------------------------------------------------------------------- /feral/early-feline-mode.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2021 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feline-mode 18 | 19 | private 20 | 21 | constant: syntax-words { 22 | "!>" 23 | "'" 24 | "(" 25 | ")" 26 | ":" 27 | ":>" 28 | ";" 29 | "=>" 30 | "[" 31 | "]" 32 | "_" 33 | "constant" 34 | "constant:" 35 | "defer" 36 | "forget" 37 | "generic" 38 | "global" 39 | "in:" 40 | "is" 41 | "local" 42 | "method:" 43 | "private" 44 | "private:" 45 | "public" 46 | "public:" 47 | "special" 48 | "symbol:" 49 | "syntax:" 50 | "test:" 51 | "tuple:" 52 | "unuse:" 53 | "use:" 54 | "using:" 55 | "var" 56 | "vector{" 57 | "{" 58 | "}" 59 | } ; 60 | 61 | constant: defining-words { 62 | ":" 63 | "constant" 64 | "constant:" 65 | "defer" 66 | "generic" 67 | "global" 68 | "method:" 69 | "private:" 70 | "public:" 71 | "special" 72 | "syntax:" 73 | "test:" 74 | "tuple:" 75 | "var" 76 | } ; 77 | 78 | constant: combinators { 79 | "&&" 80 | "2dip" 81 | "2tri" 82 | "?" 83 | "?exit" 84 | "?return" 85 | "and*" 86 | "bi" 87 | "bi@" 88 | "both?" 89 | "call" 90 | "case" 91 | "cleave" 92 | "cond" 93 | "dip" 94 | "do" 95 | "each" 96 | "each-index" 97 | "each-integer" 98 | "either?" 99 | "filter" 100 | "find" 101 | "find-from" 102 | "find-integer" 103 | "find-integer-in-range" 104 | "find-last-from" 105 | "if" 106 | "if*" 107 | "keep" 108 | "loop" 109 | "map" 110 | "map-find" 111 | "match" 112 | "or*" 113 | "recover" 114 | "return-if" 115 | "time" 116 | "times" 117 | "tri" 118 | "unless" 119 | "unless*" 120 | "until" 121 | "when" 122 | "when*" 123 | "while" 124 | "with-dynamic-scope" 125 | "||" 126 | } ; 127 | -------------------------------------------------------------------------------- /feral/winui-display.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2017-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-core segments feline accessors ; 17 | in: editor 18 | 19 | feral-config:winui? assert 20 | 21 | : update-caret-pos 22 | dot-column textview-char-width * 23 | dot-line-number top-line-number - textview-char-height * 24 | textview-set-caret-pos ; 25 | 26 | : update-mode-line mode-line-text modeline-set-text ; 27 | 28 | : repaint 29 | winui-hide-caret 30 | 31 | top-line !> line 32 | 0 !> row 33 | 34 | [ line row textview-rows <= and ] [ 35 | line row repaint-line 36 | row 1+ row! line next>> line! 37 | ] while 38 | 39 | [ row textview-rows <= ] [ 40 | 0 row textview-clear-eol 41 | row 1+ row! 42 | ] while 43 | 44 | nil repaint?! 45 | clear-changed-lines 46 | 47 | winui-show-caret ; 48 | 49 | : repaint-changed-lines 50 | winui-hide-caret 51 | 52 | top-line !> line 53 | 0 !> row 54 | 55 | [ line row textview-rows <= and ] [ 56 | line changed-lines member-eq? [ 57 | line row repaint-line 58 | ] when 59 | row 1+ row! line next>> line! 60 | ] while 61 | 62 | [ row textview-rows <= ] [ 63 | 0 row textview-clear-eol 64 | row 1+ row! 65 | ] while 66 | 67 | clear-changed-lines 68 | 69 | winui-show-caret ; 70 | 71 | : update-display-internal 72 | repaint? [ 73 | repaint 74 | ] [ 75 | dot-line-changed? [ 76 | dot-line line-changed 77 | nil dot-line-changed?! 78 | ] when 79 | repaint-changed-lines 80 | ] if 81 | update-mode-line 82 | update-caret-pos ; 83 | 84 | : update-display 85 | [ update-display-internal ] [ 86 | last-error string? [ 87 | last-error 88 | [ feral-config:termui? [ print ] unless ] 89 | [ message ] 90 | [ logging:log ] 91 | tri 92 | ] when 93 | [ print-backtrace ] logging:with-output-to-log 94 | ] recover ; 95 | 96 | : request-update-display 97 | winui-request-update-display ; 98 | -------------------------------------------------------------------------------- /feral/list-symbols.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-core feline accessors ; 17 | in: list-symbols 18 | 19 | empty 20 | 21 | : list-symbols // callable -> void 22 | 1 ?enough verify-callable :> line-is-definition-function 23 | 24 | current-buffer filename>> :> filename 25 | filename nil? ?exit 26 | 27 | // reuse existing buffer if possible 28 | buffer-list [ 29 | dup mode>> symbols-mode:get-instance eq? 30 | swap parent>> current-buffer eq? and 31 | ] find 32 | // -> index/nil element/nil 33 | [ nip dup editor:clear-buffer ] [ drop make-buffer ] if* :> buf 34 | 35 | filename file-name-nondirectory " [symbols]" + buf name<< 36 | 37 | last-line-number fixnum>string string-length :> line-number-width 38 | 39 | first-line !> source-line 40 | nil !> goal // put dot on this line in the [symbols] buffer 41 | 42 | [ source-line ] [ 43 | source-line line-is-definition-function call [ 44 | '\s' line-number-width source-line number>> 1+ fixnum>string pad-left 45 | symbols-mode:line-number-suffix + 46 | source-line text>> + 47 | make-line/1 48 | 49 | goal [ 50 | source-line number>> dot-line-number > [ 51 | buf last-line>> goal! 52 | ] when 53 | ] unless 54 | 55 | buf buffer-append-line 56 | ] when 57 | source-line next>> source-line! 58 | ] while 59 | 60 | buf first-line>> nil? [ "No symbols" message ] ?return 61 | 62 | buf first-line>> buf top-line<< 63 | goal [ buf last-line>> goal! ] unless 64 | goal 0 make-position buf dot<< 65 | 66 | true buf read-only<< 67 | 68 | current-buffer buf parent<< 69 | current-buffer-directory buf directory<< 70 | symbols-mode:get-instance buf mode<< 71 | buf mode>> initialize-buffer-function>> [ buf swap call ] when* 72 | 73 | buf in-buffer-list? [ buf buffer-list vector-push ] unless 74 | buf set-current-buffer 75 | 76 | renumber 77 | maybe-reframe 78 | true repaint?! ; 79 | -------------------------------------------------------------------------------- /feral/display.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2017-2021 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-core feline accessors segments feral-colors ; 17 | in: editor 18 | 19 | global changed-lines 20 | 21 | 16 make-vector changed-lines! 22 | 23 | : line-changed // line -> void 24 | changed-lines vector-push ; 25 | 26 | : clear-changed-lines 27 | changed-lines vector-delete-all ; 28 | 29 | : string-format-line ( s ) // string -> segments 30 | current-buffer mode>> :> mode 31 | mode [ 32 | s mode formatter call 33 | ] [ 34 | s 0 color-text make-segment/3 35 | 1array 36 | ] if ; 37 | 38 | : line-format-line // line -> segments 39 | 1 ?enough :> line 40 | current-buffer mode>> :> mode 41 | nil !> format-line-function 42 | mode [ 43 | mode format-line-function>> format-line-function! 44 | ] when 45 | format-line-function [ 46 | line format-line-function call 47 | ] ?return 48 | 49 | line text>> detab string-format-line ; 50 | 51 | : format-line ( x ) // line-or-string -> segments 52 | x line? [ x line-format-line ] ?return 53 | x verify-string string-format-line ; 54 | 55 | : mode-line-text // void -> string 56 | 256 make-sbuf :> sb 57 | modified? '*' '\s' ? sb sbuf-push 58 | current-buffer name>> "untitled" or sb sbuf-append-string 59 | dot-line-number 1+ 60 | line-count 61 | dot-column 1+ 62 | " %d(%d):%d" format sb sbuf-append-string 63 | :git-branch current-buffer buffer-get-property [ 64 | '\s' sb sbuf-push 65 | sb sbuf-append-string 66 | ] when* 67 | current-buffer mode>> [ 68 | name>> [ 69 | '\s' sb sbuf-push 70 | '(' sb sbuf-push 71 | sb sbuf-append-string 72 | ')' sb sbuf-push 73 | ] when* 74 | ] when* 75 | sb sbuf->string ; 76 | 77 | using: feral-loader feral-config feline ; 78 | 79 | winui? gtkui? or [ "display-common.feline" load-feral-source-file ] when 80 | 81 | { 82 | { [ winui? ] [ "winui-display.feline" ] } 83 | { [ gtkui? ] [ "gtkui-display.feline" ] } 84 | { [ termui? ] [ "termui-display.feline" ] } 85 | } cond load-feral-source-file 86 | -------------------------------------------------------------------------------- /feral/symbols-mode.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2021 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline accessors feral-core segments modes feral-colors ; 17 | in: symbols-mode 18 | 19 | private 20 | 21 | global instance 22 | 23 | constant: line-number-suffix ": " ; 24 | 25 | : symbols-mode-format-line ( s ) // string -> segments 26 | 27 | 16 make-vector :> v 28 | 29 | line-number-suffix s substring-start 1+ :> end 30 | 0 end s substring 0 color-linenumber make-segment/3 v push 31 | 32 | local comment-start 33 | 34 | current-buffer parent>> mode>> comment-start>> s substring-start [ 35 | comment-start! 36 | ] when* 37 | 38 | comment-start [ 39 | end comment-start s string-substring end color-text make-segment/3 v push 40 | comment-start s string-tail comment-start color-comment make-segment/3 v push 41 | ] [ 42 | end s string-tail end color-text make-segment/3 43 | v push 44 | ] if 45 | 46 | v ; 47 | 48 | : symbols-mode-goto-source 49 | dot-line-text :> s 50 | line-number-suffix s substring-start :> end 51 | end nil? ?exit 52 | 53 | editor:switch-to-parent-buffer 54 | 55 | 0 end s substring string-trim string>number :> linenumber 56 | linenumber editor:goto-line-internal 57 | t repaint?! ; 58 | 59 | global symbols-mode-local-map 60 | 61 | : initialize-local-map 62 | 128 :> m 63 | ' editor:kill-buffer feral-key:escape m set-at 64 | ' symbols-mode-goto-source feral-key:enter m set-at 65 | m symbols-mode-local-map! ; 66 | 67 | initialize-local-map 68 | 69 | feral-config:winui? feral-config:gtkui? or #if 70 | ' symbols-mode-goto-source feral-key:double-mouse-1 symbols-mode-local-map set-at 71 | #endif 72 | 73 | : symbols-mode-initialize-buffer // buffer -> void 74 | 1 ?enough :> buf 75 | symbols-mode-local-map buf local-map<< ; 76 | 77 | : initialize-symbols-mode 78 | mode make-instance :> m 79 | "symbols" m name<< 80 | ' symbols-mode-initialize-buffer m initialize-buffer-function<< 81 | ' symbols-mode-format-line m formatter<< 82 | m instance! ; 83 | 84 | initialize-symbols-mode 85 | 86 | public 87 | 88 | : get-instance // void -> mode 89 | instance ; 90 | -------------------------------------------------------------------------------- /feral/find-definition.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2017-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-core feline history mini ; 17 | in: editor 18 | 19 | : goto-location/2 // filename line-number -> void 20 | :> line-number :> filename 21 | filename [ 22 | filename find-buffer-from-file-name // -> buffer/nil 23 | [ 24 | // -> buffer 25 | set-current-buffer 26 | line-number goto-line-internal 27 | ] [ 28 | filename line-number create-buffer/2 29 | ] if* 30 | maybe-reframe 31 | true repaint?! 32 | ] when ; 33 | 34 | : goto-location/1 // 2array -> void 35 | 1 ?enough dup second :> line-number first :> filename 36 | filename line-number goto-location/2 ; 37 | 38 | : goto-definition // symbol -> void 39 | symbol-location // filename line-number 40 | goto-location/2 ; 41 | 42 | feral-config:winui? feral-config:gtkui? or #if 43 | : minibuffer-list-symbols // symbols -> void 44 | 256 :> sb 45 | [ 46 | symbol-qualified-name sb sbuf-append-string 47 | '\s' sb sbuf-push 48 | ] each 49 | sb sbuf>string minibuffer-set-text ; 50 | #else 51 | : minibuffer-list-symbols // symbols -> void 52 | 0 message-y at-xy 53 | [ symbol-qualified-name write-string space ] each ; 54 | #endif 55 | 56 | : find-definition-internal // string -> void 57 | feline-symbols:find-definition [ goto-location/1 ] when* ; 58 | 59 | : find-definition 60 | 61 | "find-definition" set-history 62 | "Word: " minibuffer-accept-string 63 | [ find-definition-internal ] when* ; 64 | 65 | // REVIEW name 66 | : find-definition-at-dot 67 | 68 | dot-offset :> old-dot-offset 69 | dot-line indentation-length :> indent 70 | 71 | dot-char whitespace? [ 72 | { 73 | { [ dot-offset indent < ] [ indent dot-offset! ] } 74 | { [ dot-offset 0> ] [ dot-offset 1- dot-offset! ] } 75 | } cond 76 | ] when 77 | 78 | identifier-at-dot // -> index/nil string/nil 79 | nip // -> string/nil 80 | old-dot-offset dot-offset! 81 | [ find-definition-internal ] when* ; 82 | -------------------------------------------------------------------------------- /feral/lisp-mode.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-core modes feline accessors segments feral-colors ; 17 | in: lisp-mode 18 | 19 | private 20 | 21 | global instance 22 | 23 | : get-instance // void -> mode 24 | instance ; 25 | 26 | : lisp-mode-identifier-char? ( x ) // x -> ? 27 | // REVIEW 28 | [ x alphanumeric? ] [ x '-' eq? ] either? ; 29 | 30 | : lisp-mode-format-line ( line ) // line -> array-of-segments 31 | line text>> detab :> s 32 | ';' s string-find-char :> comment-start 33 | 34 | comment-start [ 35 | comment-start s string-head 0 color-text make-segment/3 36 | comment-start s string-tail comment-start color-comment make-segment/3 37 | 2array 38 | ] [ 39 | s 0 color-text make-segment/3 40 | 1array 41 | ] if ; 42 | 43 | : line-is-definition? ( line ) 44 | line text>> string-trim-head :> s 45 | '\s' s string-index :> end 46 | end nil? [ nil ] ?return 47 | 0 end s string-substring { 48 | "(defun" 49 | "(defvar" 50 | "(defconstant" 51 | 52 | // elisp 53 | "(defconst" 54 | "(defface" 55 | "(defgroup" 56 | } member? ; 57 | 58 | : lisp-mode-list-symbols 59 | ' lisp-mode:line-is-definition? list-symbols:list-symbols ; 60 | 61 | global lisp-mode-local-map 62 | 63 | feral-config:winui? feral-config:gtkui? or #if 64 | 65 | : initialize-local-map 66 | 128 :> m 67 | ' lisp-mode-list-symbols feral-key:ctrl-shift-o m set-at 68 | m lisp-mode-local-map! ; 69 | 70 | initialize-local-map 71 | 72 | #endif 73 | 74 | : lisp-mode-initialize-buffer // buffer -> void 75 | 1 ?enough :> buf 76 | lisp-mode-local-map buf local-map<< 77 | instance indent-size>> buf indent-size<< ; 78 | 79 | : initialize-lisp-mode 80 | mode make-instance :> m 81 | "Lisp" m name<< 82 | 2 m indent-size<< 83 | "; " m comment-start<< 84 | ' lisp-mode-format-line m format-line-function<< 85 | ' lisp-mode-initialize-buffer m initialize-buffer-function<< 86 | ' lisp-mode-identifier-char? m identifier-char-function<< 87 | m ".lisp" modes set-at 88 | m ".el" modes set-at 89 | m instance! ; 90 | 91 | initialize-lisp-mode 92 | -------------------------------------------------------------------------------- /src/compiler-tests.feline: -------------------------------------------------------------------------------- 1 | using: unit-test feline ; 2 | in: compiler-tests 3 | 4 | empty 5 | 6 | true run-tests-when-defined?! 7 | 8 | : %test-1 9 | 42 :> x 10 | x ; 11 | 12 | test: test-1 13 | %test-1 42 assert-eq ; 14 | 15 | : %test-2 16 | 'a' :> x1 17 | 'b' :> x2 18 | 'c' :> x3 19 | 'd' :> x4 20 | 'e' :> x5 21 | 'f' :> x6 22 | 'g' :> x7 23 | 'h' :> x8 24 | 'i' :> x9 25 | 'j' :> x10 26 | 'k' :> x11 27 | 'l' :> x12 28 | 'm' :> x13 29 | 'n' :> x14 30 | 'o' :> x15 31 | 'p' :> x16 32 | 'q' :> x17 33 | 'r' :> x18 34 | 's' :> x19 35 | 't' :> x20 36 | 37 | x1 'a' assert-eq 38 | x2 'b' assert-eq 39 | x3 'c' assert-eq 40 | x4 'd' assert-eq 41 | x5 'e' assert-eq 42 | x6 'f' assert-eq 43 | x7 'g' assert-eq 44 | x8 'h' assert-eq 45 | x9 'i' assert-eq 46 | x10 'j' assert-eq 47 | x11 'k' assert-eq 48 | x12 'l' assert-eq 49 | x13 'm' assert-eq 50 | x14 'n' assert-eq 51 | x15 'o' assert-eq 52 | x16 'p' assert-eq 53 | x17 'q' assert-eq 54 | x18 'r' assert-eq 55 | x19 's' assert-eq 56 | x20 't' assert-eq ; 57 | 58 | test: test-2 59 | %test-2 ; 60 | 61 | : %test-3 62 | ?exit 42 ; 63 | 64 | test: test-3 65 | { } [ true %test-3 ] unit-test 66 | { 42 } [ nil %test-3 ] unit-test ; 67 | 68 | : %test-4 [ "test" ] ?return 42 ; 69 | 70 | test: test-4 71 | { "test" } [ true %test-4 ] unit-test 72 | { 42 } [ nil %test-4 ] unit-test ; 73 | 74 | // ?exit 75 | : %test-5 ( x ) x nil? ?exit x ; 76 | 77 | test: test-5 78 | { } [ nil %test-5 ] unit-test 79 | { 42 } [ 42 %test-5 ] unit-test ; 80 | 81 | // ?return-no-locals 82 | : %test-6 83 | [ 42 ] ?return 87 ; 84 | 85 | test: test-6 86 | { 87 } [ nil %test-6 ] unit-test 87 | { 42 } [ true %test-6 ] unit-test ; 88 | 89 | // ?return-locals 90 | : %test-7 91 | :> x x [ 42 ] ?return 87 ; 92 | 93 | test: test-7 94 | { 87 } [ nil %test-7 ] unit-test 95 | { 42 } [ true %test-7 ] unit-test ; 96 | 97 | : %test-8 98 | most-positive-fixnum :> x x ; 99 | 100 | test: test-8 101 | 4611686018427387903 most-positive-fixnum assert-eq 102 | { 4611686018427387903 } [ %test-8 ] unit-test ; 103 | 104 | : %test-9 105 | 2147483647 :> x x ; 106 | 107 | test: test-9 108 | 2147483647 max-int32 assert-eq 109 | { 2147483647 } [ %test-9 ] unit-test ; 110 | 111 | : %test-10 112 | [ 87 :> x x ] when ; 113 | 114 | test: test-10 115 | { 87 } [ true %test-10 ] unit-test 116 | { } [ nil %test-10 ] unit-test ; 117 | 118 | : %test-11 119 | [ 87 !> x x ] when ; 120 | 121 | test: test-11 122 | { 87 } [ true %test-11 ] unit-test 123 | { } [ nil %test-11 ] unit-test ; 124 | 125 | : %test-12 126 | [ local x 87 x! x ] when ; 127 | 128 | test: test-12 129 | { 87 } [ true %test-12 ] unit-test 130 | { } [ nil %test-12 ] unit-test ; 131 | -------------------------------------------------------------------------------- /feral/asm-mode.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2021 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-core modes feline accessors segments feral-colors ; 17 | in: asm-mode 18 | 19 | private 20 | 21 | global instance 22 | 23 | : get-instance // void -> mode 24 | instance ; 25 | 26 | : format-line ( line ) // line -> segments 27 | line text>> detab !> s 28 | 29 | 8 make-vector :> vec 30 | 31 | s length 0? [ vec ] ?return 32 | 33 | '\s' s string-index s length or !> i 34 | i 0> [ 0 i s substring ] [ nil ] if :> first-token 35 | 36 | first-token { "%if" "%ifdef" "%ifndef" "%else" "%endif" } member? [ 37 | first-token 0 color-preprocessor make-segment/3 vec push 38 | first-token length s string-tail s! 39 | ] [ 40 | 0 i! 41 | ] if 42 | 43 | ';' s string-find-char :> j 44 | j [ 45 | j s string-head i color-text make-segment/3 vec push 46 | j s string-tail j color-comment make-segment/3 vec push 47 | ] [ 48 | s i color-text make-segment/3 vec push 49 | ] if 50 | 51 | vec ; 52 | 53 | : line-is-definition? ( line ) 54 | line text>> string-trim-head :> s 55 | '\s' s string-index :> end 56 | end nil? [ nil ] ?return 57 | 0 end s string-substring { 58 | "code" "inline" "always_inline" "subroutine" "%macro" "%define" "deferred" 59 | } member? ; 60 | 61 | : asm-mode-list-symbols 62 | ' asm-mode:line-is-definition? list-symbols:list-symbols ; 63 | 64 | global asm-mode-local-map 65 | 66 | feral-config:winui? feral-config:gtkui? or #if 67 | 68 | : initialize-local-map 69 | 128 :> m 70 | ' asm-mode-list-symbols feral-key:ctrl-shift-o m set-at 71 | m asm-mode-local-map! ; 72 | 73 | initialize-local-map 74 | 75 | #endif 76 | 77 | : asm-mode-initialize-buffer // buffer -> void 78 | 1 ?enough :> buf 79 | asm-mode-local-map buf local-map<< 80 | instance indent-size>> buf indent-size<< ; 81 | 82 | : initialize-mode 83 | mode make-instance :> m 84 | "Feline NASM" m name<< 85 | 8 m indent-size<< 86 | "; " m comment-start<< 87 | ' format-line m format-line-function<< 88 | ' asm-mode-initialize-buffer m initialize-buffer-function<< 89 | ' asm-mode-identifier-char? m identifier-char-function<< 90 | m ".asm" modes set-at 91 | m instance! ; 92 | 93 | initialize-mode 94 | 95 | forget initialize-mode 96 | -------------------------------------------------------------------------------- /feral/history.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2019 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline accessors logging directories ; 17 | in: history 18 | 19 | public 20 | 21 | global current-history 22 | 23 | private 24 | 25 | tuple: history 26 | name 27 | filename 28 | strings 29 | index 30 | ; 31 | 32 | : name // void -> string/nil 33 | current-history [ name>> ] [ nil ] if* ; 34 | 35 | : strings // void -> vector/nil 36 | current-history [ strings>> ] [ nil ] if* ; 37 | 38 | : index // void -> index/nil 39 | current-history [ index>> ] [ nil ] if* ; 40 | 41 | : index! // index -> void 42 | current-history [ index<< ] [ drop ] if* ; 43 | 44 | public 45 | 46 | : reset-history 47 | strings [ length index! ] when* ; 48 | 49 | : history-previous // void -> string/nil 50 | index nil? [ nil ] ?return 51 | 52 | index 0> [ 53 | index 1- index! 54 | index strings nth 55 | ] [ nil ] if ; 56 | 57 | : history-next 58 | index nil? [ nil ] ?return 59 | 60 | index strings length 1- < [ 61 | index 1+ index! 62 | index strings nth 63 | ] [ reset-history nil ] if ; 64 | 65 | : history-name->pathname // name -> pathname 66 | feral-history-directory swap path-append ".history" string-append ; 67 | 68 | : load-history ( name ) // name -> history 69 | history make-instance :> hist 70 | name hist name<< 71 | feral-history-directory name path-append ".history" string-append hist filename<< 72 | name history-name->pathname :> pathname 73 | pathname regular-file? [ 74 | pathname file-lines verify-vector 75 | ] [ 76 | 100 77 | ] if 78 | hist over >>strings 79 | swap length >>index 80 | ; 81 | 82 | : save-history 83 | strings [ 84 | [ length dup 10 - 0 max swap ] keep 85 | feral-history-directory name path-append ".history" string-append 86 | set-file-lines 87 | ] when* ; 88 | 89 | : update-history ( s ) // string/nil -> void 90 | s string? [ 91 | current-history [ 92 | strings>> s swap vector-adjoin 93 | save-history 94 | ] when* 95 | ] when ; 96 | 97 | : set-history // name -> void 98 | load-history current-history! ; 99 | -------------------------------------------------------------------------------- /src/io.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2012-2021 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; ### errno 19 | value os_errno, 'errno', 0 20 | 21 | ; ### delete-file 22 | code delete_file, 'delete-file' ; string -> ? 23 | ; Returns true if successful, nil on error. 24 | _ string_raw_data_address 25 | mov arg0_register, rbx 26 | xcall os_delete_file ; os_delete_file returns 0 if successful 27 | mov ebx, TRUE 28 | mov edx, NIL 29 | test rax, rax 30 | cmovnz ebx, edx 31 | next 32 | endcode 33 | 34 | ; ### rename-file 35 | code rename_file, 'rename-file' ; old-name new-name -> ? 36 | ; returns t if successful, f on error 37 | 38 | _ string_raw_data_address 39 | mov arg1_register, rbx ; new name 40 | _drop 41 | _ string_raw_data_address 42 | mov arg0_register, rbx ; old name 43 | 44 | xcall os_rename_file ; rax = 0 if successful, -1 on error 45 | 46 | mov ebx, t_value 47 | mov edx, f_value 48 | test rax, rax 49 | cmovs ebx, edx 50 | 51 | next 52 | endcode 53 | 54 | ; ### run-shell-command 55 | code run_shell_command, 'run-shell-command' ; string -> fixnum 56 | ; returns fixnum 0 on success 57 | _ string_raw_data_address 58 | mov arg0_register, rbx 59 | extern system 60 | xcall system 61 | mov rbx, rax 62 | _tag_fixnum 63 | next 64 | endcode 65 | 66 | ; ### errno-to-string 67 | code errno_to_string, 'errno-to-string' ; n -> string 68 | mov arg0_register, rbx 69 | xcall os_strerror 70 | mov rbx, rax 71 | _ zcount 72 | _ copy_to_string 73 | next 74 | endcode 75 | 76 | ; ### date-time 77 | code date_time, 'date-time' ; -> string 78 | _lit 256 79 | _ raw_allocate 80 | _duptor 81 | popd arg0_register 82 | xcall os_date_time 83 | _rfetch 84 | _dup 85 | _ zstrlen 86 | _ copy_to_string 87 | _rfrom 88 | _ raw_free 89 | next 90 | endcode 91 | 92 | ; ### os-time 93 | code os_time, 'os-time' ; -> fixnum 94 | mov arg0_register, 0 95 | xcall time 96 | _dup 97 | mov rbx, rax 98 | _tag_fixnum 99 | next 100 | endcode 101 | -------------------------------------------------------------------------------- /src/xalloc.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2016-2020 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; initialized in initialize_dynamic_code_space (in main.c) 19 | asm_global code_space_, 0 20 | asm_global code_space_free_, 0 21 | asm_global code_space_limit_, 0 22 | 23 | %define USE_XALLOC 24 | 25 | %ifdef USE_XALLOC 26 | 27 | ; ### code-space-free 28 | code code_space_free, 'code-space-free' ; void -> fixnum 29 | _dup 30 | mov rbx, [code_space_free_] 31 | _ tag_fixnum 32 | next 33 | endcode 34 | 35 | ; ### set-code-space-free 36 | code set_code_space_free, 'set-code-space-free' ; fixnum -> void 37 | _check_fixnum 38 | mov [code_space_free_], rbx 39 | _drop 40 | next 41 | endcode 42 | 43 | ; ### xalloc 44 | code xalloc, 'xalloc' ; raw-size -> raw-address 45 | mov rax, [code_space_free_] 46 | 47 | add rbx, rax 48 | cmp rbx, [code_space_limit_] 49 | jge .1 50 | 51 | ; REVIEW 52 | ; 16-byte alignment 53 | add rbx, 0x0f 54 | and bl, 0xf0 55 | 56 | mov [code_space_free_], rbx 57 | 58 | mov rbx, rax 59 | _return 60 | 61 | .1: 62 | _ ?nl 63 | _write "FATAL: no code space" 64 | _ nl 65 | xcall os_bye 66 | 67 | next 68 | endcode 69 | 70 | ; ### xfree 71 | code xfree, 'xfree' ; raw-address -> void 72 | ; for now, do nothing 73 | _drop 74 | 75 | next 76 | endcode 77 | 78 | %endif 79 | 80 | ; ### raw_allocate_executable 81 | code raw_allocate_executable, 'raw_allocate_executable', SYMBOL_INTERNAL 82 | ; raw-size -> raw-address 83 | 84 | %ifdef USE_XALLOC 85 | 86 | _ xalloc 87 | 88 | %else 89 | 90 | mov arg0_register, rbx 91 | %ifdef WIN64 92 | xcall os_allocate_executable 93 | %else 94 | xcall os_malloc 95 | %endif 96 | mov rbx, rax 97 | 98 | %endif 99 | 100 | next 101 | endcode 102 | 103 | ; ### raw_free_executable 104 | code raw_free_executable, 'raw_free_executable', SYMBOL_INTERNAL 105 | ; raw-address -> void 106 | 107 | %ifdef USE_XALLOC 108 | 109 | _ xfree 110 | 111 | %else 112 | 113 | mov arg0_register, rbx 114 | %ifdef WIN64 115 | xcall os_free_executable 116 | %else 117 | xcall os_free 118 | %endif 119 | _drop 120 | 121 | %endif 122 | 123 | next 124 | endcode 125 | -------------------------------------------------------------------------------- /src/time.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2012-2019 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; http://www.intel.com/content/www/us/en/embedded/training/ia-32-ia-64-benchmark-code-execution-paper.html 19 | 20 | ; ### rdtsc 21 | inline read_time_stamp_counter, 'rdtsc' ; -- u 22 | ; serialize 23 | xor eax, eax 24 | cpuid 25 | 26 | _rdtsc 27 | endinline 28 | 29 | ; ### ticks 30 | code ticks, 'ticks' ; -- u 31 | xcall os_ticks 32 | pushd rax 33 | next 34 | endcode 35 | 36 | ; ### raw_nano_count 37 | code raw_nano_count, 'raw_nano_count', SYMBOL_INTERNAL ; -- raw-uint64 38 | xcall os_nano_count 39 | _dup 40 | mov rbx, rax 41 | next 42 | endcode 43 | 44 | ; ### nano-count 45 | code nano_count, 'nano-count' ; -- ns 46 | xcall os_nano_count 47 | _dup 48 | mov rbx, rax 49 | _ normalize 50 | next 51 | endcode 52 | 53 | ; ### elapsed 54 | code elapsed, 'elapsed' ; callable -- ns cycles 55 | 56 | ; protect quotation from gc 57 | push rbx 58 | 59 | _ callable_raw_code_address 60 | 61 | push r12 62 | mov r12, rbx 63 | poprbx 64 | 65 | _ raw_nano_count 66 | _tor 67 | _rdtsc 68 | _tor 69 | 70 | call r12 71 | 72 | _rdtsc 73 | _ raw_nano_count 74 | 75 | _swap 76 | _rfrom 77 | _minus 78 | _tag_fixnum 79 | _swap 80 | _rfrom 81 | _minus 82 | _tag_fixnum 83 | _swap ; -- ns cycles 84 | 85 | pop r12 86 | 87 | ; drop quotation 88 | pop rax 89 | 90 | next 91 | endcode 92 | 93 | ; ### time 94 | code feline_time, 'time' ; callable -> void 95 | 96 | _ elapsed ; -> ns cycles 97 | 98 | _swap ; -> cycles ns 99 | 100 | _ ?nl 101 | 102 | _ fixnum_to_float 103 | _lit tagged_fixnum(1000000) 104 | _ fixnum_to_float 105 | _ float_float_divide 106 | _ float_to_string 107 | _ write_string 108 | _quote " ms (" 109 | _ write_string ; -> cycles 110 | 111 | _ fixnum_to_string 112 | _ write_string 113 | _quote " cycles)" 114 | _ write_string 115 | _ nl 116 | 117 | next 118 | endcode 119 | -------------------------------------------------------------------------------- /feral/diff-mode.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline accessors feral-core segments modes feral-colors ; 17 | in: diff-mode 18 | 19 | private 20 | 21 | global instance 22 | 23 | : diff-mode-goto-source 24 | dot-line !> line 25 | nil !> found 26 | 0 !> count 27 | 28 | [ line ] [ 29 | "@@" line text>> head? [ 30 | line found! nil line! 31 | ] [ 32 | "-" line text>> head? [ count 1+ count! ] unless 33 | line prev>> line! 34 | ] if 35 | ] while 36 | 37 | found nil? ?exit 38 | 39 | found text>> :> s 40 | '+' s string-find-char 1+ s string-tail :> s2 41 | ',' s2 string-find-char s2 head :> s3 42 | 43 | s3 string>number count + 44 | 1- 0 max // convert to zero-based line number 45 | :> linenumber 46 | 47 | // REVIEW parent buffer may have been killed 48 | editor:switch-to-parent-buffer 49 | 50 | linenumber editor:goto-line-internal 51 | true repaint?! ; 52 | 53 | global diff-mode-local-map 54 | 55 | : initialize-local-map 56 | 128 :> m 57 | ' editor:kill-buffer feral-key:escape m set-at 58 | ' diff-mode-goto-source feral-key:enter m set-at 59 | m diff-mode-local-map! ; 60 | 61 | initialize-local-map 62 | 63 | feral-config:winui? feral-config:gtkui? or #if 64 | ' diff-mode-goto-source feral-key:double-mouse-1 diff-mode-local-map set-at 65 | #endif 66 | 67 | : diff-mode-format-line ( s ) // string -> segments 68 | 69 | s length 0? [ s trivial-format-line ] ?return 70 | 71 | "+++" s head? [ s trivial-format-line ] ?return 72 | "---" s head? [ s trivial-format-line ] ?return 73 | 74 | s string-first-char { 75 | { '+' [ color-insertion ] } 76 | { '-' [ color-deletion ] } 77 | [ 78 | // default case 79 | drop 80 | color-text 81 | ] 82 | } case :> color 83 | 84 | s 0 color make-segment/3 1array ; 85 | 86 | : diff-mode-initialize-buffer // buffer -> void 87 | 1 ?enough :> buf 88 | diff-mode-local-map buf local-map<< ; 89 | 90 | : initialize-diff-mode 91 | mode make-instance :> m 92 | "Diff" m name<< 93 | ' diff-mode-initialize-buffer m initialize-buffer-function<< 94 | ' diff-mode-format-line m formatter<< 95 | m instance! ; 96 | 97 | initialize-diff-mode 98 | 99 | public 100 | 101 | : get-instance // void -> mode 102 | instance ; 103 | -------------------------------------------------------------------------------- /benchmarks/bench-hashtable.feline: -------------------------------------------------------------------------------- 1 | using: feline ; 2 | in: bench-hashtable 3 | 4 | empty 5 | 6 | global ht 7 | 8 | global count 10000000 count! 9 | 10 | : test1 11 | 2 make-fixnum-hashtable ht! 12 | count [ dup 17 + swap ht fixnum-hashtable-set-at ] each-integer ; 13 | 14 | : test2 15 | // assertions are slow 16 | count [ dup ht fixnum-hashtable-at 17 - assert-eq ] each-integer ; 17 | 18 | : test3 19 | // no assertions 20 | count [ ht fixnum-hashtable-at drop ] each-integer ; 21 | 22 | : test4 23 | // looking for keys that aren't there 24 | count [ count + ht fixnum-hashtable-at drop ] each-integer ; 25 | 26 | : bench 27 | // first verify correct behavior 28 | test1 test2 nil ht! 29 | gc 30 | 31 | ?nl "test1" print 32 | 5 [ ' test1 time ] times 33 | gc 34 | 35 | ?nl "test2" print 36 | 5 [ ' test2 time ] times 37 | gc 38 | 39 | ?nl "test3" print 40 | 5 [ ' test3 time ] times 41 | gc 42 | 43 | ?nl "test4" print 44 | 5 [ ' test4 time ] times 45 | 46 | nil ht! 47 | gc ; 48 | 49 | global xht 50 | 51 | : xtest1 52 | 2 xht! 53 | // make-fixnum-hashtable/0 xht! 54 | count [ dup 17 + swap xht set-at ] each-integer ; 55 | 56 | : xtest2 57 | // assertions are slow 58 | count [ dup xht at 17 - assert-eq ] each-integer ; 59 | 60 | : xtest3 61 | // no assertions 62 | count [ xht at drop ] each-integer ; 63 | 64 | : xtest4 65 | // looking for keys that aren't there 66 | 6777210 [ 67 | count + xht at drop 68 | ] each-integer ; 69 | 70 | // 2 71 | 72 | // 10000000 fails 73 | // 7000000 fails 74 | // 6777225 works (2.578 seconds) 75 | // 6777210 works (322 ms) 76 | // 6777210 works (330 ms) 77 | // 6777200 works (441 ms) 78 | // 6777000 works (408 ms) 79 | 80 | 81 | // make-fixnum-hashtable/0 82 | 83 | // 6800000 fails 84 | // 6760000 works 85 | // 6780000 fails 86 | // 6777000 works 87 | // 6779000 fails 88 | // 6778000 works but very very slow (~25 seconds) 89 | // 6777500 works (~9 seconds) 90 | // 6777250 works (1.237 seconds) 91 | // 6777250 works (1.223 seconds) 92 | // 6777245 works (1.056 seconds) 93 | // 6777240 works (0.911 seconds) 94 | // 6777235 works (0.748 seconds) 95 | // 6777225 works (491 ms) 96 | 97 | // 6777220 works (336 ms) 98 | // 6777219 works (312 ms) 99 | // 6777218 works (289 ms) 100 | // 6777217 works (263 ms) 101 | // 6777216 works (229 ms) 102 | // 6777215 works (226 ms) 103 | 104 | // 6777210 works (225 ms) 105 | // 6777200 works (246 ms) 106 | // 6777160 works (229 ms) 107 | // 6777150 works (246 ms) 108 | // 6777125 works (234 ms) 109 | // 6777000 works (224 ms) 110 | // 6776000 works (247 ms) 111 | // 6775000 works (224 ms) 112 | // 6774000 works (234 ms) 113 | // 6770000 works (~230 ms) 114 | 115 | : xbench 116 | // first verify correct behavior 117 | xtest1 xtest2 nil xht! 118 | gc 119 | 120 | ?nl "xtest1" print 121 | 5 [ ' xtest1 time ] times 122 | gc 123 | 124 | ?nl "xtest2" print 125 | 5 [ ' xtest2 time ] times 126 | gc 127 | 128 | ?nl "xtest3" print 129 | 5 [ ' xtest3 time ] times 130 | gc 131 | 132 | ?nl "xtest4" print 133 | 5 [ ' xtest4 time ] times 134 | 135 | nil ht! 136 | gc 137 | ; 138 | -------------------------------------------------------------------------------- /src/move.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2012-2020 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; ### cmove 19 | code cmove, 'cmove', SYMBOL_INTERNAL ; c-addr1 c-addr2 u -- 20 | %ifdef WIN64 21 | push rsi 22 | push rdi 23 | %endif 24 | mov rcx, rbx ; count 25 | mov rdi, [rbp] ; destination 26 | mov rsi, [rbp + BYTES_PER_CELL] ; source 27 | _3drop 28 | jrcxz .1 29 | rep movsb 30 | .1: 31 | %ifdef WIN64 32 | pop rdi 33 | pop rsi 34 | %endif 35 | next 36 | endcode 37 | 38 | ; ### cmove> 39 | code cmoveup, 'cmove>', SYMBOL_INTERNAL ; source destination count -> void 40 | %ifdef WIN64 41 | push rsi 42 | push rdi 43 | %endif 44 | mov rcx, rbx ; count (in bytes) 45 | mov rdi, [rbp] ; destination 46 | mov rsi, [rbp + BYTES_PER_CELL] ; source 47 | _3drop 48 | jrcxz .1 49 | dec rcx 50 | add rdi, rcx 51 | add rsi, rcx 52 | inc rcx 53 | std 54 | rep movsb 55 | cld 56 | .1: 57 | %ifdef WIN64 58 | pop rdi 59 | pop rsi 60 | %endif 61 | next 62 | endcode 63 | 64 | ; ### move_cells 65 | subroutine move_cells 66 | ; arg0_register: untagged source address 67 | ; arg1_register: untagged destination address 68 | ; arg2_register: untagged count (cells, not bytes) 69 | ; handles overlapping moves correctly 70 | 71 | ; do nothing if count <= 0 72 | test arg2_register, arg2_register 73 | jle .exit 74 | 75 | cmp arg0_register, arg1_register 76 | 77 | ; do nothing if source = destination 78 | jz .exit 79 | 80 | ja .2 81 | 82 | ; source < destination 83 | ; copy last cell first 84 | .1: 85 | mov rax, [arg0_register + BYTES_PER_CELL * arg2_register - BYTES_PER_CELL] 86 | mov [arg1_register + BYTES_PER_CELL * arg2_register - BYTES_PER_CELL], rax 87 | sub arg2_register, 1 88 | jnz .1 89 | ret 90 | 91 | .2: 92 | ; source > destination 93 | ; copy first cell first 94 | xor eax, eax 95 | .3: 96 | mov r10, [arg0_register + rax * BYTES_PER_CELL] 97 | mov [arg1_register + rax * BYTES_PER_CELL], r10 98 | add rax, 1 99 | cmp arg2_register, rax 100 | jne .3 101 | 102 | .exit: 103 | ret 104 | endsub 105 | -------------------------------------------------------------------------------- /src/socket.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2017 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; ### make-socket 19 | code make_socket, 'make-socket' ; host port -- fd 20 | 21 | _check_fixnum 22 | mov arg1_register, rbx 23 | poprbx 24 | 25 | _ string_raw_data_address 26 | mov arg0_register, rbx 27 | poprbx 28 | 29 | xcall c_make_socket 30 | 31 | pushrbx 32 | mov rbx, rax 33 | 34 | next 35 | endcode 36 | 37 | ; ### make-server-socket 38 | code make_server_socket, 'make-server-socket' ; port -- fd 39 | _check_fixnum 40 | mov arg0_register, rbx 41 | poprbx 42 | xcall c_make_server_socket 43 | pushrbx 44 | mov rbx, rax 45 | next 46 | endcode 47 | 48 | ; ### accept-connection 49 | code accept_connection, 'accept-connection' ; fd-listen -- fd-connect 50 | mov arg0_register, rbx 51 | poprbx 52 | xcall c_accept_connection 53 | pushrbx 54 | mov rbx, rax 55 | next 56 | endcode 57 | 58 | ; ### socket-read-char 59 | code socket_read_char, 'socket-read-char' ; fd -- char/f 60 | mov arg0_register, rbx 61 | xcall c_socket_read_char 62 | test rax, rax 63 | js .1 64 | mov ebx, eax 65 | _tag_char 66 | _return 67 | .1: 68 | mov ebx, f_value 69 | next 70 | endcode 71 | 72 | ; ### socket-write-char 73 | code socket_write_char, 'socket-write-char' ; tagged-char fd -- 74 | _untag_char qword [rbp] 75 | popd arg1_register 76 | popd arg0_register 77 | xcall c_socket_write_char 78 | next 79 | endcode 80 | 81 | ; ### socket-write-string 82 | code socket_write_string, 'socket-write-string' ; string fd -- 83 | _tor 84 | _dup 85 | _ string_raw_data_address 86 | _swap 87 | _ string_raw_length 88 | _rfrom ; -- buf count fd 89 | popd arg0_register 90 | popd arg2_register 91 | popd arg1_register 92 | xcall c_socket_write 93 | test rax, rax 94 | jns .1 95 | _error "error writing to socket" 96 | .1: 97 | next 98 | endcode 99 | 100 | ; ### socket-close 101 | code socket_close, 'socket-close' ; fd -- 102 | popd arg0_register 103 | xcall c_socket_close 104 | test rax, rax 105 | js .1 106 | _return 107 | .1: 108 | _error "unable to close socket" 109 | next 110 | endcode 111 | -------------------------------------------------------------------------------- /feral/feral-colors.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | feral-config:winui? feral-config:gtkui? or #if 17 | 18 | using: feline accessors ; 19 | in: feral-colors 20 | 21 | : make-colorref ( r g b ) // r g b -> fixnum 22 | b 16 lshift g 8 lshift + r + ; 23 | 24 | : colorref-red // colorref -> r 25 | 0xff bitand ; 26 | 27 | : colorref-green // colorref -> g 28 | 8 rshift 0xff bitand ; 29 | 30 | : colorref-blue // colorref -> b 31 | 16 rshift 0xff bitand ; 32 | 33 | : colorref->rgb // colorref -> r g b 34 | [ colorref-red ] 35 | [ colorref-green ] 36 | [ colorref-blue ] 37 | tri ; 38 | 39 | constant: color-text 192 192 192 make-colorref ; 40 | constant: color-comment 128 128 0 make-colorref ; 41 | constant: color-disabled 128 128 128 make-colorref ; 42 | 43 | constant: color-header 160 160 0 make-colorref ; 44 | 45 | constant: color-syntax 100 149 237 make-colorref ; // cornflower blue 46 | constant: color-combinator 100 149 237 make-colorref ; 47 | 48 | constant: color-name 255 165 0 make-colorref ; 49 | constant: color-string 0 170 0 make-colorref ; 50 | constant: color-preprocessor 255 69 0 make-colorref ; 51 | constant: color-keyword 210 105 30 make-colorref ; 52 | constant: color-type 153 77 0 make-colorref ; 53 | 54 | constant: color-linenumber 128 128 0 make-colorref ; 55 | constant: color-filename 77 166 255 make-colorref ; 56 | 57 | constant: color-insertion 0 153 0 make-colorref ; 58 | constant: color-deletion 153 0 0 make-colorref ; 59 | 60 | #else 61 | 62 | using: ansi-color feline accessors ; 63 | in: feral-colors 64 | 65 | constant: color-text 192 192 192 rgb-foreground-prefix ; 66 | constant: color-comment 128 128 0 rgb-foreground-prefix ; 67 | 68 | constant: color-syntax 0 255 255 rgb-foreground-prefix ; 69 | constant: color-name 255 165 0 rgb-foreground-prefix ; 70 | constant: color-string 0 170 0 rgb-foreground-prefix ; 71 | constant: color-combinator 0 153 153 rgb-foreground-prefix ; 72 | constant: color-preprocessor 255 69 0 rgb-foreground-prefix ; 73 | constant: color-keyword 210 105 30 rgb-foreground-prefix ; 74 | constant: color-type 153 77 0 rgb-foreground-prefix ; 75 | 76 | constant: color-linenumber 128 128 0 rgb-foreground-prefix ; 77 | constant: color-filename 77 166 255 rgb-foreground-prefix ; 78 | 79 | constant: color-insertion 0 153 0 rgb-foreground-prefix ; 80 | constant: color-deletion 153 0 0 rgb-foreground-prefix ; 81 | 82 | #endif 83 | -------------------------------------------------------------------------------- /src/externs.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2012-2020 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | extern malloc 17 | extern realloc 18 | extern free 19 | 20 | extern time 21 | 22 | %ifndef WIN64 23 | extern realpath 24 | %endif 25 | 26 | %ifdef WIN64 27 | extern CreateMutexA 28 | %endif 29 | 30 | extern os_accept_string 31 | extern os_allocate_executable 32 | extern os_bye 33 | extern os_chdir 34 | extern os_close_file 35 | extern os_current_thread 36 | 37 | %ifdef WIN64 38 | extern os_current_thread_raw_thread_handle 39 | extern os_get_full_path_name 40 | %endif 41 | 42 | extern os_current_thread_raw_thread_id 43 | extern os_date_time 44 | extern os_delete_file 45 | extern os_emit_file 46 | extern os_file_create_write 47 | extern os_file_is_directory 48 | extern os_file_is_regular_file 49 | extern os_file_open_append 50 | extern os_file_open_read 51 | extern os_file_position 52 | extern os_file_size 53 | extern os_file_status 54 | extern os_file_write_time 55 | extern os_flush_file 56 | extern os_free 57 | extern os_free_executable 58 | extern os_getcwd 59 | extern os_getenv 60 | extern os_initialize_primordial_thread 61 | extern os_key 62 | extern os_key_avail 63 | extern os_malloc 64 | extern os_mutex_init 65 | extern os_mutex_lock 66 | extern os_mutex_trylock 67 | extern os_mutex_unlock 68 | extern os_nano_count 69 | extern os_open_file 70 | extern os_read_char 71 | extern os_read_file 72 | extern os_realloc 73 | extern os_rename_file 74 | extern os_reposition_file 75 | extern os_resize_file 76 | extern os_sleep 77 | extern os_strerror 78 | extern os_thread_create 79 | extern os_thread_initialize_datastack 80 | extern os_thread_join 81 | extern os_ticks 82 | extern os_write_file 83 | 84 | %ifdef WIN64 85 | extern os_get_console_character_attributes 86 | %endif 87 | 88 | extern c_get_saved_backtrace_array 89 | extern c_get_saved_backtrace_size 90 | extern c_random 91 | extern c_save_backtrace 92 | extern c_seed_random 93 | 94 | ; numbers.c 95 | extern c_decimal_to_number 96 | extern c_fixnum_to_base 97 | extern c_float_expt 98 | extern c_float_float_divide 99 | extern c_float_float_ge 100 | extern c_float_float_gt 101 | extern c_float_float_le 102 | extern c_float_float_lt 103 | extern c_float_float_minus 104 | extern c_float_float_multiply 105 | extern c_float_float_plus 106 | extern c_float_floor 107 | extern c_float_negate 108 | extern c_float_sqrt 109 | extern c_float_to_string 110 | extern c_float_truncate 111 | extern c_pi 112 | extern c_raw_int64_to_float 113 | extern c_raw_uint64_to_float 114 | extern c_string_to_float 115 | extern c_string_to_integer 116 | 117 | ; math.c 118 | extern c_float_sin 119 | 120 | ; socket.c 121 | extern c_accept_connection 122 | extern c_make_server_socket 123 | extern c_make_socket 124 | extern c_socket_close 125 | extern c_socket_read_char 126 | extern c_socket_write 127 | extern c_socket_write_char 128 | -------------------------------------------------------------------------------- /feral/feral-loader.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2021 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: user 18 | 19 | { 20 | "accept-string" 21 | "ansi-color" 22 | "asm-mode" 23 | "c-mode" 24 | "completion" 25 | "diff-mode" 26 | "directories" 27 | "directory-mode" 28 | "disassembly-mode" 29 | "editor" 30 | "feline-mode" 31 | "feline-symbols" 32 | "feral-colors" 33 | "feral-commands" 34 | "feral-core" 35 | "feral-hooks" 36 | "feral-key" 37 | "find-in-files" 38 | "forth-mode" 39 | "go-mode" 40 | "history" 41 | "java-mode" 42 | "js-mode" 43 | "keymaps" 44 | "kill-ring" 45 | "lisp-mode" 46 | "list-buffers" 47 | "list-symbols" 48 | "logging" 49 | "mini" 50 | "modes" 51 | "recent-files" 52 | "rust-mode" 53 | "search" 54 | "search-mode" 55 | "swift-mode" 56 | "symbols-mode" 57 | } [ delete-vocab ] each 58 | 59 | in: feral-loader 60 | 61 | empty 62 | 63 | constant: feral-source-directory feline-home "feral" path-append ; 64 | 65 | : load-feral-source-file // string -> void 66 | feral-source-directory swap path-append load ; 67 | 68 | feral-source-directory add-directory-to-load-path 69 | 70 | : load-feral 71 | { 72 | "feral-commands.feline" 73 | "feral-config.feline" 74 | "feral-key.feline" 75 | "feral-colors.feline" 76 | "feral-hooks.feline" 77 | "directories.feline" 78 | "logging.feline" 79 | "feral-core.feline" 80 | "history.feline" 81 | "completion.feline" 82 | "accept-string.feline" 83 | "modes.feline" 84 | "display.feline" 85 | "undo.feline" 86 | "move.feline" 87 | "mini.feline" 88 | "kill-ring.feline" 89 | "edit.feline" 90 | "save.feline" 91 | "quit.feline" 92 | "buffer.feline" 93 | "early-feline-mode.feline" 94 | "symbols-mode.feline" 95 | "list-symbols.feline" 96 | "feline-symbols.feline" 97 | "find-definition.feline" 98 | "asm-mode.feline" 99 | "c-mode.feline" 100 | "java-mode.feline" 101 | "js-mode.feline" 102 | "feline-mode.feline" 103 | "forth-mode.feline" 104 | "go-mode.feline" 105 | "lisp-mode.feline" 106 | "rust-mode.feline" 107 | "swift-mode.feline" 108 | "list-buffers.feline" 109 | "diff-mode.feline" 110 | "git.feline" 111 | "disassembly-mode.feline" 112 | "directory-mode.feline" 113 | "search-mode.feline" 114 | "search.feline" 115 | "find-in-files.feline" 116 | "recent-files.feline" 117 | "commands.feline" 118 | "keymaps.feline" 119 | } ' load-feral-source-file each 120 | ; 121 | 122 | load-feral 123 | -------------------------------------------------------------------------------- /src/wrapper.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2016-2020 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; 2 cells: object header, wrapped object 19 | %define WRAPPER_SIZE 2 * BYTES_PER_CELL 20 | 21 | %define WRAPPER_WRAPPED_OFFSET 8 22 | 23 | ; ### check_wrapper 24 | code check_wrapper, 'check_wrapper' ; wrapper -> ^wrapper 25 | cmp bl, HANDLE_TAG 26 | jne error_not_wrapper 27 | mov rax, rbx 28 | shr rbx, HANDLE_TAG_BITS 29 | mov rbx, [rbx] 30 | cmp word [rbx], TYPECODE_WRAPPER 31 | jne .error 32 | next 33 | .error: 34 | mov rbx, rax 35 | jmp error_not_wrapper 36 | endcode 37 | 38 | ; ### error-not-wrapper 39 | code error_not_wrapper, 'error-not-wrapper' ; x -> 40 | _quote "a wrapper" 41 | _ format_type_error 42 | next 43 | endcode 44 | 45 | ; ### 46 | code new_wrapper, '' ; object -> wrapper 47 | 48 | mov arg0_register, WRAPPER_SIZE 49 | _ feline_malloc ; returns address in rax 50 | 51 | mov qword [rax], TYPECODE_WRAPPER 52 | mov qword [rax + WRAPPER_WRAPPED_OFFSET], rbx 53 | mov rbx, rax 54 | 55 | ; return handle 56 | _ new_handle ; -> handle 57 | 58 | next 59 | endcode 60 | 61 | ; ### wrapper? 62 | code wrapper?, 'wrapper?' ; x -> x/nil 63 | ; If x is a wrapper, return x unchanged. If x is not a wrapper, return nil. 64 | cmp bl, HANDLE_TAG 65 | jne .not_a_wrapper 66 | mov rax, rbx 67 | shr rax, HANDLE_TAG_BITS 68 | mov rax, [rax] 69 | cmp word [rax], TYPECODE_WRAPPER 70 | jne .not_a_wrapper 71 | next 72 | .not_a_wrapper: 73 | mov ebx, NIL 74 | next 75 | endcode 76 | 77 | ; ### wrapped 78 | code wrapped, 'wrapped' ; wrapper -> wrapped 79 | _ check_wrapper 80 | mov rbx, [rbx + WRAPPER_WRAPPED_OFFSET] 81 | next 82 | endcode 83 | 84 | ; ### literalize 85 | code literalize, 'literalize' ; obj -> wrapped 86 | _dup 87 | _ symbol? 88 | _tagged_if .1 89 | _ new_wrapper 90 | _return 91 | _then .1 92 | 93 | _dup 94 | _ wrapper? 95 | _tagged_if .2 96 | _ new_wrapper 97 | _return 98 | _then .2 99 | 100 | ; no wrapper needed 101 | next 102 | endcode 103 | 104 | ; ### wrapper>string 105 | code wrapper_to_string, 'wrapper>string' ; wrapper -> string 106 | _quote "' " 107 | _ string_to_sbuf 108 | _swap 109 | _ wrapped 110 | _ object_to_string 111 | _over 112 | _ sbuf_append_string 113 | _ sbuf_to_string 114 | next 115 | endcode 116 | -------------------------------------------------------------------------------- /src/feline.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2012-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | #ifndef FELINE_H 17 | #define FELINE_H 18 | 19 | #include // int64_t 20 | #include 21 | 22 | #ifdef WIN64 23 | #include 24 | #endif 25 | 26 | typedef int64_t cell; 27 | 28 | #ifndef WIN64 29 | typedef cell COLORREF; 30 | #define RGB(r, g, b) ((COLORREF) (r + (g << 8) + (b << 16))) 31 | #endif 32 | 33 | // These #defines must be kept in sync with macros.asm and object-macros.asm. 34 | #define T_VALUE 14 35 | #define F_VALUE 0 36 | 37 | #define TYPECODE_FLOAT 17 38 | #define TYPECODE_INT64 22 39 | 40 | #define FIXNUM_TAG_BITS 1 41 | 42 | #if FIXNUM_TAG_BITS == 1 43 | #define make_fixnum(n) (((cell) n << 1) + 1) 44 | #define MOST_POSITIVE_FIXNUM ((cell) 4611686018427387903) 45 | #define MOST_NEGATIVE_FIXNUM ((cell) -4611686018427387904) 46 | #elif FIXNUM_TAG_BITS == 3 47 | #define make_fixnum(n) (((cell) n << 3) + 1) 48 | #define MOST_POSITIVE_FIXNUM ((cell) 1152921504606846975) 49 | #define MOST_NEGATIVE_FIXNUM ((cell) -1152921504606846976) 50 | #endif 51 | 52 | // int64.asm 53 | typedef struct 54 | { 55 | cell header; 56 | int64_t n; 57 | } Int64; 58 | 59 | // float.asm 60 | typedef struct 61 | { 62 | cell header; 63 | double d; 64 | } Float; 65 | 66 | // numbers.c 67 | Float *make_float(double d); 68 | 69 | // os.c 70 | cell os_ticks (void); 71 | cell os_close_file (cell fd); 72 | cell os_write_file (cell fd, void * buf, size_t count); 73 | cell os_nano_count (void); 74 | cell os_thread_initialize_datastack (void); 75 | cell os_current_thread (void); 76 | 77 | #ifdef WIN64 78 | extern DWORD tls_index; 79 | #else 80 | extern pthread_key_t tls_key; 81 | #endif 82 | 83 | // terminal.c 84 | void prep_terminal (void); 85 | void deprep_terminal (void); 86 | 87 | // backtrace.c 88 | void c_save_backtrace (cell rip, cell rsp); 89 | 90 | extern cell os_errno_data; 91 | 92 | extern cell start_time_raw_nano_count_; 93 | 94 | extern cell terminal_columns_; 95 | extern cell terminal_rows_; 96 | 97 | #ifdef WIN64 98 | extern cell saved_exception_code_data; 99 | extern cell saved_exception_address_data; 100 | #else 101 | extern cell saved_signal_data; 102 | extern cell saved_signal_address_data; 103 | #endif 104 | extern cell saved_rax_data; 105 | extern cell saved_rbx_data; 106 | extern cell saved_rcx_data; 107 | extern cell saved_rdx_data; 108 | extern cell saved_rsi_data; 109 | extern cell saved_rdi_data; 110 | extern cell saved_rbp_data; 111 | extern cell saved_rsp_data; 112 | extern cell saved_r8_data; 113 | extern cell saved_r9_data; 114 | extern cell saved_r10_data; 115 | extern cell saved_r11_data; 116 | extern cell saved_r12_data; 117 | extern cell saved_r13_data; 118 | extern cell saved_r14_data; 119 | extern cell saved_r15_data; 120 | extern cell saved_rip_data; 121 | extern cell saved_efl_data; 122 | 123 | #endif // FELINE_H 124 | -------------------------------------------------------------------------------- /src/boot.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feline 18 | 19 | "compiler.feline" load-system-file 20 | 21 | public 22 | 23 | : blank? // char -> ? 24 | "\t\n\r " member? ; 25 | 26 | : apropos ( pattern ) 27 | all-words [ symbol-name pattern swap substring-start ] filter 28 | [ 29 | dup symbol-qualified-name write 30 | symbol-private? [ 48 tab "private" write ] when 31 | nl 32 | ] each ; 33 | 34 | : a 35 | must-parse-token apropos ; 36 | 37 | { 38 | "syntax.feline" 39 | "declare.feline" 40 | "control.feline" 41 | "backtrace.feline" 42 | "dump.feline" 43 | "chars.feline" 44 | "strings.feline" 45 | "sequences.feline" 46 | "files.feline" 47 | "tuple.feline" 48 | "tokenize.feline" 49 | "accept.feline" 50 | "help.feline" 51 | } ' load-system-file each 52 | 53 | private 54 | 55 | feline-source-directory "disassembler.feline" path-append constant disassembler.feline 56 | 57 | global disassembler-file-write-time 58 | 59 | : maybe-load-disassembler 60 | disassembler.feline file-write-time disassembler-file-write-time neq? [ 61 | disassembler.feline [ load ] [ file-write-time disassembler-file-write-time! ] bi 62 | ] when ; 63 | 64 | public 65 | 66 | : d 67 | maybe-load-disassembler 68 | "disassembler" use-vocab 69 | "d" "disassembler" vocab-find-name [ call-symbol ] when ; 70 | 71 | private 72 | 73 | feline-home "feral" path-append "editor.feline" path-append constant editor.feline 74 | 75 | : load-editor 76 | [ 77 | nil load-verbose? set 78 | editor.feline load 79 | ] with-dynamic-scope ; 80 | 81 | feline-home "feral" path-append "editorx.feline" path-append constant editorx.feline 82 | 83 | : load-editorx 84 | [ 85 | nil load-verbose? set 86 | editorx.feline load 87 | ] with-dynamic-scope ; 88 | 89 | : load-inspector 90 | [ 91 | nil load-verbose? set 92 | "inspector.feline" load-system-file 93 | ] with-dynamic-scope ; 94 | 95 | public 96 | 97 | : e 98 | "editor" delete-vocab 99 | load-editor 100 | "editor" use-vocab 101 | "edit" "editor" vocab-find-name [ call-symbol ] when ; 102 | 103 | : x 104 | "editor" delete-vocab 105 | load-editorx 106 | "editor" use-vocab 107 | "edit" "editor" vocab-find-name [ call-symbol ] when ; 108 | 109 | : i 110 | "inspector" delete-vocab 111 | load-inspector 112 | "inspect" "inspector" vocab-find-name [ call-symbol ] when ; 113 | 114 | : run-tests 115 | [ 116 | true load-verbose? set 117 | 118 | { 119 | "test.feline" 120 | "control-test.feline" 121 | "random-tests.feline" 122 | "clisp-tests.feline" 123 | "stress.feline" 124 | } [ load-system-file nl nl ] each 125 | 126 | .version 127 | 128 | ] with-dynamic-scope ; 129 | -------------------------------------------------------------------------------- /src/help.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2019 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: help 18 | 19 | empty 20 | 21 | private 22 | 23 | 96 code-char constant backquote 24 | 25 | white constant fg-title 26 | cyan constant fg-parameter 27 | white constant fg-default 28 | 29 | : bold color? [ esc[ "1m" write-string ] when ; 30 | : normal color? [ esc[ "0m" write-string ] when ; 31 | 32 | : format-string // string -> 33 | :> s! 34 | f :> in-quote?! 35 | f :> i! 36 | color? [ 37 | backquote s index i! 38 | [ 39 | i 40 | ] [ 41 | i s string-head write-string 42 | i 1+ i! 43 | i s string-tail s! 44 | in-quote? not in-quote?! 45 | in-quote? fg-parameter fg-default ? foreground 46 | backquote s index i! 47 | ] while 48 | ] when 49 | s write-string ; 50 | 51 | : format-title // string -> 52 | bold 53 | fg-title foreground 54 | write-string 55 | normal 56 | fg-default foreground ; 57 | 58 | feline-source-directory "feline.help" path-append constant feline.help 59 | 60 | var glossary 61 | var glossary-file-write-time 62 | 63 | : maybe-load-glossary 64 | feline.help file-write-time glossary-file-write-time eq? [ 65 | ?nl "Loading glossary" print 66 | feline.help [ file-lines glossary! ] [ file-write-time glossary-file-write-time! ] bi 67 | ] unless ; 68 | 69 | public 70 | 71 | : symbol-help // symbol -> string/f 72 | symbol-name :> name 73 | 74 | maybe-load-glossary 75 | 76 | glossary [ name swap string-has-prefix? ] find // index/f element/f 77 | 78 | :> line 79 | :> line-number! 80 | 81 | f :> v! 82 | f :> sb! 83 | f :> help-string! 84 | 85 | line [ 86 | 8 v! 87 | [ 88 | line-number 1+ line-number! 89 | line-number glossary vector-length >= 90 | ] [ 91 | line-number glossary vector-nth 92 | dup " " over string-has-prefix? swap empty? or [ 93 | v vector-push 94 | ] [ 95 | drop glossary vector-length line-number! 96 | ] if 97 | ] until 98 | 99 | v empty? [ 100 | v vector-last empty? [ v vector-pop* ] when 101 | ] unless 102 | 103 | 256 sb! 104 | v [ sb sbuf-append-string 10 code-char sb sbuf-push ] each 105 | sb sbuf>string help-string! 106 | ] when 107 | 108 | help-string 109 | ; 110 | 111 | : help // symbol -> 112 | dup symbol-name :> name 113 | symbol-help [ 114 | name format-title nl 115 | format-string 116 | ] when* 117 | ; 118 | 119 | using: feline help ; 120 | in: feline 121 | 122 | : help help:help ; 123 | 124 | : h 125 | parse-token [ find-name [ help:help ] [ drop ] if ] when* ; 126 | -------------------------------------------------------------------------------- /src/defer.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2018-2020 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; ### make-deferred 19 | code make_deferred, 'make-deferred' ; symbol -> void 20 | _dup 21 | _ symbol_set_deferred_bit ; -> symbol 22 | _dup 23 | _tick error_no_definition 24 | _ curry ; -> symbol quotation 25 | _ compile_quotation 26 | _dup ; -> symbol quotation quotation 27 | _pick ; -> symbol quotation quotation symbol 28 | _ symbol_set_def ; -> symbol quotation 29 | _ quotation_raw_code_address ; -> symbol raw-code-address 30 | _over 31 | _ symbol_set_value 32 | _ compile_deferred 33 | next 34 | endcode 35 | 36 | ; ### defer 37 | code defer, 'defer', SYMBOL_IMMEDIATE 38 | _tick defer 39 | _ top_level_only 40 | 41 | _ parse_name 42 | _ make_deferred 43 | next 44 | endcode 45 | 46 | ; ### verify-deferred 47 | code verify_deferred, 'verify-deferred' ; symbol -> symbol 48 | _dup 49 | _ deferred? 50 | _tagged_if_not .1 51 | _ error_not_deferred 52 | _then .1 53 | next 54 | endcode 55 | 56 | ; ### defer! 57 | code defer_store, 'defer!' ; symbol1 symbol2 -> void 58 | _ verify_deferred 59 | cmp rbx, [rbp] 60 | jne .1 61 | _error "ERROR: the arguments to `defer!` must not be identical." 62 | .1: 63 | _swap 64 | _ symbol_raw_code_address 65 | _swap 66 | _ symbol_set_value 67 | next 68 | endcode 69 | 70 | ; ### is 71 | code is_, 'is', SYMBOL_IMMEDIATE ; symbol1 -> 72 | _ must_parse_token ; -> symbol1 string 73 | _ must_find_name ; -> symbol1 symbol2 74 | 75 | _ in_definition? 76 | _ get 77 | _tagged_if .1 78 | _get_accum 79 | _dup 80 | _tagged_if .2 81 | _swap ; -> vector symbol2 82 | _ new_wrapper ; -> vector wrapper 83 | _over ; -> vector wrapper vector 84 | _ vector_push ; -> vector 85 | _tick defer_store 86 | _swap 87 | _ vector_push 88 | _else .2 89 | _drop 90 | _then .2 91 | _else .1 92 | ; not in definition 93 | _ defer_store 94 | _then .1 95 | 96 | next 97 | endcode 98 | 99 | ; ### error-not-deferred 100 | code error_not_deferred, 'error-not-deferred' ; symbol -> 101 | _quote "ERROR: the word `%s` is not deferred." 102 | _ format 103 | _ error 104 | next 105 | endcode 106 | 107 | ; ### error-no-definition 108 | code error_no_definition, 'error-no-definition' ; symbol -> void 109 | _quote "ERROR: no definition for the deferred word `%s`." 110 | _ format 111 | _ error 112 | next 113 | endcode 114 | -------------------------------------------------------------------------------- /src/memory.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2012-2020 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | subroutine feline_malloc 19 | ; Call with raw number of bytes to allocate in arg0_register. 20 | ; Returns raw address in rax. 21 | xcall malloc 22 | test rax, rax 23 | jz error_out_of_memory 24 | ret 25 | endsub 26 | 27 | ; ### raw_allocate 28 | code raw_allocate, 'raw_allocate', SYMBOL_INTERNAL ; raw-size -> raw-address 29 | mov arg0_register, rbx 30 | xcall malloc 31 | test rax, rax 32 | jz error_out_of_memory 33 | mov rbx, rax 34 | next 35 | endcode 36 | 37 | ; ### raw_realloc 38 | code raw_realloc, 'raw_realloc', SYMBOL_INTERNAL 39 | ; raw-address raw-size -> new-raw-address 40 | mov arg1_register, rbx 41 | mov arg0_register, [rbp] 42 | lea rbp, [rbp + BYTES_PER_CELL] 43 | _os_realloc 44 | test rax, rax 45 | mov rbx, rax 46 | jz error_out_of_memory 47 | next 48 | endcode 49 | 50 | ; ### raw_free 51 | code raw_free, 'raw_free', SYMBOL_INTERNAL ; raw-address -> void 52 | mov arg0_register, rbx 53 | _drop 54 | _os_free 55 | next 56 | endcode 57 | 58 | ; ### raw_erase_bytes 59 | code raw_erase_bytes, 'raw_erase_bytes', SYMBOL_INTERNAL 60 | ; raw-address raw-count -- 61 | %ifdef WIN64 62 | push rdi ; rdi is callee-saved on Windows 63 | %endif 64 | xor al, al ; 0 in al 65 | mov rcx, rbx ; count in rcx 66 | mov rdi, [rbp] 67 | mov rbx, [rbp + BYTES_PER_CELL] 68 | lea rbp, [rbp + BYTES_PER_CELL * 2] 69 | jrcxz .1 ; do nothing if count = 0 70 | rep stosb 71 | .1: 72 | %ifdef WIN64 73 | pop rdi 74 | %endif 75 | next 76 | endcode 77 | 78 | ; ### raw_erase_cells 79 | code raw_erase_cells, 'raw_erase_cells', SYMBOL_INTERNAL 80 | ; raw-address raw-count -- 81 | %ifdef WIN64 82 | push rdi ; rdi is callee-saved on Windows 83 | %endif 84 | xor eax, eax ; 0 in rax 85 | mov rcx, rbx ; count in rcx 86 | mov rdi, [rbp] 87 | mov rbx, [rbp + BYTES_PER_CELL] 88 | lea rbp, [rbp + BYTES_PER_CELL * 2] 89 | jrcxz .1 ; do nothing if count = 0 90 | 91 | align DEFAULT_CODE_ALIGNMENT 92 | .2: 93 | mov [rdi], rax 94 | sub rcx, 1 95 | jz .1 96 | mov [rdi + BYTES_PER_CELL], rax 97 | sub rcx, 1 98 | jz .1 99 | mov [rdi + BYTES_PER_CELL * 2], rax 100 | sub rcx, 1 101 | jz .1 102 | mov [rdi + BYTES_PER_CELL * 3], rax 103 | add rdi, BYTES_PER_CELL * 4 104 | sub rcx, 1 105 | jz .1 106 | jmp .2 107 | .1: 108 | %ifdef WIN64 109 | pop rdi 110 | %endif 111 | next 112 | endcode 113 | -------------------------------------------------------------------------------- /src/lvar.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2021 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; 4 cells: object header, name, type, index 19 | %define LVAR_SIZE 4 * BYTES_PER_CELL 20 | 21 | %define LVAR_NAME_OFFSET 8 22 | %define LVAR_TYPE_OFFSET 16 23 | %define LVAR_INDEX_OFFSET 24 24 | 25 | ; ### lvar? 26 | code lvar?, 'lvar?' ; x -> x/nil 27 | ; If x is an lvar, returns x unchanged, otherwise returns nil. 28 | cmp bl, HANDLE_TAG 29 | jne .no 30 | mov rax, rbx 31 | shr rax, HANDLE_TAG_BITS 32 | mov rax, [rax] 33 | cmp word [rax], TYPECODE_LVAR 34 | jne .no 35 | next 36 | .no: 37 | %if NIL = 0 38 | xor ebx, ebx 39 | %else 40 | mov ebx, NIL 41 | %endif 42 | next 43 | endcode 44 | 45 | ; ### check_lvar 46 | code check_lvar, 'check_lvar' ; lvar -> ^lvar 47 | cmp bl, HANDLE_TAG 48 | jne .error2 49 | mov rax, rbx 50 | shr rbx, HANDLE_TAG_BITS 51 | mov rbx, [rbx] 52 | cmp word [rbx], TYPECODE_LVAR 53 | jne .error1 54 | next 55 | .error1: 56 | mov rbx, rax 57 | .error2: 58 | _ error_not_lvar 59 | next 60 | endcode 61 | 62 | ; ### verify-lvar 63 | code verify_lvar, 'verify-lvar' ; lvar -> lvar 64 | ; Returns argument unchanged. 65 | cmp bl, HANDLE_TAG 66 | jne .error 67 | mov rax, rbx 68 | shr rax, HANDLE_TAG_BITS 69 | mov rax, [rax] 70 | cmp word [rax], TYPECODE_LVAR 71 | jne .error 72 | next 73 | .error: 74 | _ error_not_lvar 75 | next 76 | endcode 77 | 78 | ; ### error-not-lvar 79 | code error_not_lvar, 'error-not-lvar' ; x -> 80 | _quote "an lvar" 81 | _ format_type_error 82 | next 83 | endcode 84 | 85 | ; ### make-lvar 86 | code make_lvar, 'make-lvar' ; void -> lvar 87 | 88 | mov arg0_register, LVAR_SIZE 89 | _ feline_malloc ; returns address in rax 90 | 91 | mov qword [rax], TYPECODE_LVAR 92 | mov qword [rax + LVAR_NAME_OFFSET], NIL 93 | mov qword [rax + LVAR_TYPE_OFFSET], NIL 94 | mov qword [rax + LVAR_INDEX_OFFSET], NIL 95 | _dup 96 | mov rbx, rax 97 | 98 | ; return handle 99 | _ new_handle ; -> handle 100 | 101 | next 102 | endcode 103 | 104 | ; ### lvar-name 105 | code lvar_name, 'lvar-name' ; lvar -> string/nil 106 | _ check_lvar 107 | mov rbx, [rbx + LVAR_NAME_OFFSET] 108 | next 109 | endcode 110 | 111 | ; ### lvar-type 112 | code lvar_type, 'lvar-type' ; lvar -> type/nil 113 | _ check_lvar 114 | mov rbx, [rbx + LVAR_TYPE_OFFSET] 115 | next 116 | endcode 117 | 118 | ; ### lvar-index 119 | code lvar_index, 'lvar-index' ; lvar -> index/nil 120 | _ check_lvar 121 | mov rbx, [rbx + LVAR_INDEX_OFFSET] 122 | next 123 | endcode 124 | -------------------------------------------------------------------------------- /src/inspector.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2018-2021 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: inspector 18 | 19 | empty 20 | 21 | global inspected-object 22 | 23 | : make-typed-slot // arg index -> slot 24 | :> index 25 | :> arg 26 | arg string? [ 27 | arg index make-slot 28 | ] [ 29 | arg array? assert 30 | arg first arg second index 31 | make-slot/3 32 | ] if 33 | ; 34 | 35 | : builtin-type-set-layout // slots type -> void 36 | [ [ 1+ make-typed-slot ] map-index ] dip type-set-layout 37 | ; 38 | 39 | { 40 | "symbol" 41 | { "raw-typecode" :raw } 42 | "layout" 43 | } type builtin-type-set-layout 44 | 45 | { 46 | { "raw-code-address" :raw } 47 | { "raw-code-size" :raw } 48 | "symbol" 49 | "methods" 50 | "dispatch" 51 | } generic-function builtin-type-set-layout 52 | 53 | { 54 | { "raw typecode" :raw } 55 | "generic function" 56 | "callable" 57 | "symbol" 58 | } method builtin-type-set-layout 59 | 60 | { 61 | "array" 62 | { "raw-code-address" :raw } 63 | { "raw-code-size" :raw } 64 | "parent" 65 | "locals" 66 | } quotation builtin-type-set-layout 67 | 68 | { 69 | { "count" :raw } 70 | { "deleted" :raw } 71 | { "capacity" :raw } 72 | { "data address" :raw } 73 | { "hash function" :raw } 74 | { "test function" :raw } 75 | { "raw mask" :raw } 76 | } hashtable builtin-type-set-layout 77 | 78 | { 79 | { "capacity" :raw } 80 | { "occupancy" :raw } 81 | { "deletions" :raw } 82 | { "data address" :raw } 83 | { "old data address" :rax } 84 | { "raw mask" :raw } 85 | } fixnum-hashtable builtin-type-set-layout 86 | 87 | { "name" "hashtable" } vocab builtin-type-set-layout 88 | 89 | { 90 | "name" 91 | "vocab name" 92 | "hashcode" 93 | "def" 94 | "props" 95 | "value" 96 | { "raw-code-address" :raw } 97 | { "raw-code-size" :raw } 98 | { "raw-flags" :raw } 99 | "file" 100 | "line number" 101 | } symbol builtin-type-set-layout 102 | 103 | { 104 | "base string" 105 | { "data address" :raw } 106 | { "length" :raw } 107 | } string-slice builtin-type-set-layout 108 | 109 | { 110 | { "length" :raw } 111 | { "data address" :raw } 112 | { "capacity" :rax } 113 | } vector builtin-type-set-layout 114 | 115 | { 116 | { "length" :raw } 117 | { "data address" :raw } 118 | { "capacity" :rax } 119 | } byte-vector builtin-type-set-layout 120 | 121 | : print-slot ( object n ) // object n -> void 122 | object object-layout :> layout 123 | n layout nth :> slot 124 | 4 tab 125 | n 1+ 2 dec.r 126 | 8 tab 127 | slot slot-name write 128 | 40 tab 129 | object n 1+ slot@ 130 | slot slot-type :raw eq? [ normalize hex. nl ] [ short. ] if ; 131 | 132 | : inspect 133 | 1 ?enough 134 | dup inspected-object! 135 | inspected-object type-of type-name print 136 | inspected-object object-layout :> layout 137 | layout [ 138 | layout length dup "%d slots" format print 139 | [ inspected-object swap print-slot ] each-integer 140 | ] when ; 141 | -------------------------------------------------------------------------------- /feral/accept-string.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2017-2019 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline key history ; 17 | in: accept-string 18 | 19 | empty 20 | 21 | private 22 | 23 | var dot 24 | var bindings 25 | var sb 26 | var done? 27 | var prompt-string 28 | 29 | : prompt 30 | prompt-style 31 | prompt-string write-string ; 32 | 33 | : redisplay 34 | 0 at-x 35 | prompt 36 | input-style 37 | sb write-sbuf 38 | clear-to-eol 39 | dot prompt-string length + at-x ; 40 | 41 | : bind-key // key symbol -> 42 | swap bindings set-at ; 43 | 44 | : lookup-key // key -> symbol/f 45 | bindings at ; 46 | 47 | : do-enter 48 | reset-history 49 | t done?! ; 50 | 51 | : do-escape 52 | 0 sb sbuf-shorten 53 | reset-history 54 | t done?! ; 55 | 56 | : do-bs 57 | dot 0 > [ 58 | dot 1- dot! 59 | dot sb sbuf-remove-nth! drop 60 | reset-history 61 | redisplay 62 | ] when ; 63 | 64 | : do-previous 65 | history-previous :> s 66 | s [ 67 | 0 sb sbuf-shorten 68 | s sb sbuf-append-string 69 | sb length dot! 70 | redisplay 71 | ] when 72 | ; 73 | 74 | : do-next 75 | history-next :> s 76 | 0 sb sbuf-shorten 77 | s [ 78 | s sb sbuf-append-string 79 | sb length dot! 80 | ] [ 81 | 0 dot! 82 | ] if 83 | redisplay 84 | ; 85 | 86 | : do-normal-char // char -> 87 | dup write-char dot 1+ dot! sb push ; 88 | 89 | : initialize-bindings 90 | 32 bindings! 91 | key:enter ' do-enter bind-key 92 | key:del ' do-bs bind-key // Linux 93 | key:backspace ' do-bs bind-key // Windows 94 | key:ctrl-backspace ' do-bs bind-key 95 | key:escape ' do-escape bind-key 96 | key:up ' do-previous bind-key 97 | key:down ' do-next bind-key 98 | ; 99 | 100 | : process-key // tagged-char -> 101 | dup printable-char? 102 | [ do-normal-char ] 103 | [ lookup-key [ call-symbol ] when* ] 104 | if ; 105 | 106 | public 107 | 108 | : accept-string // prompt -> string 109 | 1 ?enough 110 | verify-string prompt-string! 111 | initialize-bindings 112 | 128 sb! 113 | 0 dot! 114 | f done?! 115 | prompt 116 | input-style 117 | show-cursor 118 | [ done? ] [ ekey process-key ] until 119 | sb sbuf>string 120 | dup update-history 121 | output-style ; 122 | 123 | : accept-string/2 // prompt default -> string 124 | 2 ?enough 125 | "" or verify-string :> default 126 | verify-string prompt-string! 127 | initialize-bindings 128 | default string>sbuf sb! 129 | sb length dot! 130 | f done?! 131 | redisplay 132 | input-style 133 | show-cursor 134 | [ done? ] [ ekey process-key ] until 135 | sb sbuf>string 136 | dup update-history 137 | output-style ; 138 | -------------------------------------------------------------------------------- /src/tuple.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feline 18 | 19 | private 20 | 21 | global tuple-typecode // -> fixnum 22 | global tuple-symbol // -> symbol 23 | global tuple-name // -> string 24 | global slots // -> array 25 | global generic-reader // -> symbol 26 | global generic-writer // -> symbol 27 | 28 | : define-generic-reader // slot -> void 29 | [ slot-name ] 30 | [ slot-index ] bi 31 | :> index 32 | ">>" string-append "accessors" ensure-generic generic-reader! 33 | 34 | // accessors must be public 35 | generic-reader symbol-set-public 36 | 37 | index { 38 | { 1 [ ' tuple-slot1@ 1array ] } 39 | { 2 [ ' tuple-slot2@ 1array ] } 40 | { 3 [ ' tuple-slot3@ 1array ] } 41 | // default case 42 | [ ' slot@ 2array ] 43 | } case 44 | array->quotation :> quotation 45 | 46 | tuple-typecode 47 | generic-reader symbol-def verify-generic-function 48 | quotation 49 | make-method 50 | install-method ; 51 | 52 | : define-generic-writer // slot -> void 53 | [ slot-name ] 54 | [ slot-index ] bi 55 | :> index 56 | "<<" string-append "accessors" ensure-generic generic-writer! 57 | 58 | // accessors must be public 59 | generic-writer symbol-set-public 60 | 61 | tuple-typecode 62 | ' verify-typecode 63 | index 64 | ' slot! 65 | 4array array->quotation :> quotation 66 | 67 | tuple-typecode 68 | generic-writer symbol-def verify-generic-function 69 | quotation 70 | make-method 71 | install-method ; 72 | 73 | : define-setter // slot -> void 74 | ">>" swap slot-name string-append :> setter-name 75 | 76 | setter-name accessors-vocab lookup-symbol ?exit 77 | 78 | // not found 79 | setter-name accessors-vocab :> setter 80 | 81 | // accessors must be public 82 | setter symbol-set-public 83 | 84 | ' over 85 | generic-writer 86 | 2array array->quotation setter symbol-set-def 87 | setter compile-word ; 88 | 89 | : define-accessors 90 | slots [ 91 | { 92 | [ define-generic-reader ] 93 | [ define-generic-writer ] 94 | [ define-setter ] 95 | } cleave 96 | ] each ; 97 | 98 | : define-tuple-predicate 99 | tuple-name "?" string-append new-symbol-in-current-vocab 100 | 101 | ' object-typecode 102 | tuple-typecode 103 | ' eq? 104 | 3array array->quotation 105 | 106 | over symbol-set-def 107 | compile-word ; 108 | 109 | : define-tuple-type 110 | tuple-symbol slots make-tuple-type type-typecode tuple-typecode! ; 111 | 112 | : parse-tuple-slots 113 | 10 make-vector 114 | [ must-parse-token dup ";" string=? ] [ suffix! ] until 115 | drop 116 | vector->array 117 | [ 1+ make-slot ] map-index slots! ; 118 | 119 | public 120 | 121 | : tuple: 122 | parse-name [ tuple-symbol! ] [ symbol-name tuple-name! ] bi 123 | 124 | parse-tuple-slots 125 | define-tuple-type 126 | define-accessors 127 | define-tuple-predicate ; 128 | -------------------------------------------------------------------------------- /feral/save.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2017-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feral-core feline accessors mini ; 17 | in: editor 18 | 19 | : buffer-make-backup ( buf ) 20 | buf filename>> [ 21 | dup file-exists? 22 | [ dup "~" string-append copy-file ] [ drop ] if 23 | ] when* ; 24 | 25 | : make-backup 26 | current-buffer buffer-make-backup ; 27 | 28 | : trim-trailing* ( s ) // string -> string/string' ? 29 | // if whitespace was trimmed, return string' t 30 | // if there was no change, return string f 31 | s string-trim-tail dup s neq? ; 32 | 33 | : buffer-remove-trailing-whitespace ( buf ) 34 | // REVIEW no undo 35 | 36 | buf first-line>> !> line 37 | 38 | // first see if there's anything to do 39 | f !> found 40 | [ line found not and ] [ 41 | line text>> string-?last whitespace? [ 42 | line found! 43 | ] [ 44 | line next>> line! 45 | ] if 46 | ] while 47 | 48 | found nil? ?exit // nothing to do 49 | 50 | line found assert-eq 51 | 52 | [ line ] [ 53 | line text>> string-?last whitespace? [ 54 | line text>> string-trim-tail line text<< 55 | ] when 56 | line next>> line! 57 | ] while 58 | 59 | // adjust dot and mark if necessary 60 | buf dot>> offset>> buf dot>> line>> text>> length > [ 61 | buf dot>> line>> text>> length buf dot>> offset<< 62 | ] when 63 | 64 | buf mark>> [ 65 | buf mark>> offset>> buf mark>> line>> text>> length > [ 66 | buf mark>> line>> text>> length buf mark>> offset<< 67 | ] when 68 | ] when 69 | 70 | modified 71 | 72 | buf current-buffer eq? [ t repaint?! ] when ; 73 | 74 | : do-save 75 | current-buffer filename>> !> filename 76 | 77 | filename [ 78 | "File: " minibuffer-accept-string filename! 79 | filename [ 80 | filename file-exists? [ 81 | "Overwrite existing file? (yes or no) " minibuffer-accept-string 82 | "yes" = [ nil filename! ] unless 83 | ] when 84 | ] when 85 | ] unless 86 | 87 | filename nil? ?exit 88 | 89 | modified? nil? [ "Not modified" message ] ?return 90 | 91 | // save the current buffer to disk 92 | "Saving..." message 93 | 94 | nil !> saved? 95 | 96 | make-backup 97 | 98 | current-buffer buffer-remove-trailing-whitespace 99 | 100 | current-buffer eol>> :> eol 101 | line-count 80 * :> sb 102 | nano-count :> start-ns 103 | 104 | // all lines but the last are followed by eol 105 | first-line !> line 106 | [ line ] [ 107 | line text>> sb sbuf-append-string 108 | line next>> [ 109 | eol sb sbuf-append-string 110 | ] when 111 | line next>> line! 112 | ] while 113 | 114 | sb sbuf>string filename // -> string filename 115 | 116 | // set-file-contents might throw 117 | [ set-file-contents t saved?! ] [ 2nip message ] recover 118 | 119 | nano-count start-ns - :> elapsed-ns 120 | 121 | saved? [ 122 | mod-count mod-count-last-save! 123 | elapsed-ns 1000000 /i "Saving...done (%s ms)" format message 124 | current-buffer filename>> [ 125 | filename canonical-path current-buffer filename<< 126 | ] unless 127 | ] when ; 128 | -------------------------------------------------------------------------------- /src/key.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2016-2019 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; ### wait_for_key 19 | code wait_for_key, 'wait_for_key', SYMBOL_INTERNAL ; -- 20 | xcall os_key_avail 21 | test rax, rax 22 | jnz .exit 23 | _ safepoint 24 | _lit tagged_fixnum(25) 25 | _ sleep 26 | jmp wait_for_key 27 | .exit: 28 | next 29 | endcode 30 | 31 | ; ### raw_key 32 | code raw_key, 'raw_key', SYMBOL_INTERNAL ; -- untagged-char 33 | xcall os_key 34 | pushd rax 35 | next 36 | endcode 37 | 38 | ; ### raw_key? 39 | code raw_key?, 'raw_key?', SYMBOL_INTERNAL ; -- untagged 40 | xcall os_key_avail ; returns non-zero if a key has been pressed 41 | pushd rax 42 | next 43 | endcode 44 | 45 | ; ### key 46 | code feline_key, 'key' ; -- tagged-char 47 | _ wait_for_key 48 | xcall os_key 49 | pushd rax 50 | _tag_char 51 | next 52 | endcode 53 | 54 | ; ### key? 55 | code feline_key?, 'key?' ; -- ? 56 | xcall os_key_avail 57 | pushrbx 58 | mov ebx, f_value 59 | mov edx, t_value 60 | test rax, rax 61 | cmovnz ebx, edx 62 | next 63 | endcode 64 | 65 | %ifdef WIN64 66 | 67 | ; Windows console 68 | 69 | ; : ekey ( -- x ) 70 | ; key 71 | ; dup 0= if 72 | ; drop 73 | ; key $8000 or tag-fixnum 74 | ; exit 75 | ; then 76 | ; dup $80 u< if \ normal character 77 | ; tag-fixnum 78 | ; exit 79 | ; then 80 | ; dup $e0 = if 81 | ; drop 82 | ; key $8000 or tag-fixnum 83 | ; exit 84 | ; then 85 | ; ; 86 | 87 | ; ### ekey 88 | code ekey, 'ekey' ; -- tagged-fixnum/tagged-char 89 | 90 | _ wait_for_key 91 | 92 | _ raw_key 93 | 94 | _dup 95 | _zeq_if .1 96 | _drop 97 | _ raw_key 98 | _lit 0x8000 99 | _or 100 | _tag_fixnum 101 | _return 102 | _then .1 103 | 104 | _dup 105 | _lit 0x80 106 | _ult 107 | _if .2 108 | _tag_char 109 | _return 110 | _then .2 111 | 112 | _dup 113 | _lit 0xe0 114 | _equal 115 | _if .3 116 | _drop 117 | _ raw_key 118 | _lit 0x8000 119 | _or 120 | _tag_fixnum 121 | _return 122 | _then .3 123 | 124 | next 125 | endcode 126 | 127 | %else 128 | 129 | ; Linux 130 | 131 | ; : ekey ( -- x ) 132 | ; key 133 | ; dup $1b = if 134 | ; begin 135 | ; key? 136 | ; while 137 | ; 8 lshift 138 | ; key or 139 | ; repeat 140 | ; then 141 | ; tag-fixnum 142 | ; ; 143 | 144 | ; ### ekey 145 | code ekey, 'ekey' ; -- fixnum 146 | 147 | _ wait_for_key 148 | 149 | _ raw_key 150 | 151 | _dup 152 | _lit 0x1b 153 | _equal 154 | _if .1 155 | _begin .2 156 | _ raw_key? 157 | _while .2 158 | _lit 8 159 | _lshift 160 | _ raw_key 161 | _or 162 | _repeat .2 163 | _then .1 164 | 165 | _dup 166 | _lit 0x80 167 | _ult 168 | _if .3 169 | _tag_char 170 | _else .3 171 | _tag_fixnum 172 | _then .3 173 | 174 | next 175 | endcode 176 | 177 | %endif 178 | -------------------------------------------------------------------------------- /src/feline.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2012-2021 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | default abs ; use absolute addresses by default 17 | 18 | %include "feline_home.asm" 19 | %include "externs.asm" 20 | %include "macros.asm" 21 | %include "loop-macros.asm" 22 | %include "inlines.asm" 23 | 24 | section .data 25 | static_data_area: 26 | 27 | %include "io.asm" 28 | %include "stack.asm" 29 | 30 | %include "cold.asm" 31 | %include "move.asm" 32 | %include "memory.asm" 33 | %include "debug.asm" 34 | %include "key.asm" 35 | %include "vocabs.asm" 36 | %include "boolean.asm" 37 | %include "object-macros.asm" 38 | %include "type.asm" 39 | %include "vector.asm" 40 | %include "byte-vector.asm" 41 | %include "handles.asm" 42 | %include "lvar.asm" 43 | %include "locals.asm" 44 | %include "hashtable-common.asm" 45 | %include "hashtable.asm" 46 | %include "fixnum-hashtable.asm" 47 | %include "equal-hashtable.asm" 48 | %include "generic.asm" 49 | %include "method.asm" 50 | %include "fixnum.asm" 51 | %include "uint64.asm" 52 | %include "int64.asm" 53 | %include "bitops.asm" 54 | %include "float.asm" 55 | %include "numbers.asm" 56 | %include "math.asm" 57 | %include "objects.asm" 58 | %include "array.asm" 59 | %include "bit-array.asm" 60 | %include "string.asm" 61 | %include "string-slice.asm" 62 | %include "sbuf.asm" 63 | %include "slice.asm" 64 | %include "range.asm" 65 | %include "sequences.asm" 66 | %include "symbol.asm" 67 | %include "keyword.asm" 68 | %include "vocab.asm" 69 | %include "wrapper.asm" 70 | %include "quotation.asm" 71 | %include "slot.asm" 72 | %include "tuple.asm" 73 | %include "dynamic-scope.asm" 74 | %include "combinators.asm" 75 | %include "quit.asm" 76 | %include "lexer.asm" 77 | %include "iterator.asm" 78 | %include "string-iterator.asm" 79 | %include "primitives.asm" 80 | %include "format.asm" 81 | %include "time.asm" 82 | %include "thread.asm" 83 | %include "file-output-stream.asm" 84 | %include "string-output-stream.asm" 85 | %include "stream.asm" 86 | %include "gc2.asm" 87 | %include "syntax.asm" 88 | %include "assert.asm" 89 | %include "xalloc.asm" 90 | %include "compile-word.asm" 91 | %include "recover.asm" 92 | %include "files.asm" 93 | %include "load.asm" 94 | %include "errors.asm" 95 | %include "tools.asm" 96 | %include "ansi.asm" 97 | %include "color.asm" 98 | %include "socket.asm" 99 | %include "mutex.asm" 100 | %include "defer.asm" 101 | 102 | %ifdef WIN64 ; Windows 103 | 104 | feline_constant have_gtkui?, 'have-gtkui?', NIL 105 | 106 | %ifdef WINUI 107 | %include "winui.asm" 108 | feline_constant have_winui?, 'have-winui?', TRUE 109 | %else 110 | feline_constant have_winui?, 'have-winui?', NIL 111 | %endif 112 | 113 | %endif ; Windows 114 | 115 | %ifndef WIN64 ; Linux 116 | 117 | feline_constant have_winui?, 'have-winui?', NIL 118 | 119 | %ifdef GTKUI 120 | %include "gtkui.asm" 121 | feline_constant have_gtkui?, 'have-gtkui?', TRUE 122 | %else 123 | feline_constant have_gtkui?, 'have-gtkui?', NIL 124 | %endif 125 | 126 | %endif ; Linux 127 | 128 | ; ### in-static-data-area? 129 | code in_static_data_area?, 'in-static-data-area?', SYMBOL_PRIMITIVE | SYMBOL_PRIVATE 130 | ; addr -- ? 131 | cmp rbx, static_data_area 132 | jb .1 133 | cmp rbx, static_data_area_limit 134 | jae .1 135 | mov ebx, TRUE 136 | next 137 | .1: 138 | mov ebx, NIL 139 | next 140 | endcode 141 | 142 | code last_static_symbol, 'last-static-symbol', SYMBOL_PRIMITIVE | SYMBOL_PRIVATE 143 | _dup 144 | mov rbx, symbol_link 145 | next 146 | endcode 147 | 148 | section .data 149 | static_data_area_limit: 150 | -------------------------------------------------------------------------------- /src/tuple.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2016-2018 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; ### error-not-tuple 19 | code error_not_tuple, 'error-not-tuple' ; x -- 20 | ; REVIEW 21 | _error "not a tuple" 22 | next 23 | endcode 24 | 25 | ; ### tuple-instance? 26 | code tuple_instance?, 'tuple-instance?' ; x -- ? 27 | _ deref 28 | test rbx, rbx 29 | jz .1 30 | _object_raw_typecode_eax 31 | cmp eax, LAST_BUILTIN_TYPECODE 32 | jbe .1 33 | mov ebx, t_value 34 | next 35 | .1: 36 | mov ebx, f_value 37 | next 38 | endcode 39 | 40 | ; ### check_tuple_instance 41 | code check_tuple_instance, 'check_tuple_instance', SYMBOL_INTERNAL 42 | ; handle -- raw-tuple-instance 43 | _dup 44 | _ deref 45 | test rbx, rbx 46 | jz .error 47 | _object_raw_typecode_eax 48 | cmp eax, LAST_BUILTIN_TYPECODE 49 | jbe .error 50 | _nip 51 | next 52 | .error: 53 | _drop 54 | _ error_not_tuple 55 | next 56 | endcode 57 | 58 | ; ### tuple-size 59 | code tuple_size, 'tuple-size' ; tuple -- size 60 | ; return number of named slots 61 | 62 | _ check_tuple_instance ; -> raw-tuple-instance 63 | 64 | tuple_size_unchecked: 65 | 66 | _object_raw_typecode 67 | _ raw_typecode_to_type 68 | _ type_layout 69 | _ array_length 70 | 71 | next 72 | endcode 73 | 74 | ; ### make-instance 75 | code make_instance, 'make-instance' ; type -> instance 76 | 77 | _ verify_type 78 | 79 | _dup 80 | _ type_layout 81 | _ array_raw_length 82 | 83 | ; slot 0 is object header 84 | add rbx, 1 85 | 86 | _cells 87 | _ raw_allocate ; -> type address 88 | 89 | _tor ; -> type 90 | 91 | _dup 92 | _ type_raw_typecode ; -> type raw-typecode 93 | 94 | ; store raw typecode in object header 95 | _rfetch 96 | _store ; -> type 97 | 98 | _ type_layout 99 | _ array_raw_length 100 | 101 | mov rcx, rbx ; number of slots in rcx 102 | poprbx 103 | 104 | jrcxz .2 105 | 106 | mov eax, f_value 107 | 108 | _rfetch 109 | add rbx, BYTES_PER_CELL 110 | 111 | mov rdx, rbx 112 | poprbx 113 | 114 | .1: 115 | mov [rdx], rax 116 | add rdx, BYTES_PER_CELL 117 | dec rcx 118 | jnz .1 119 | 120 | .2: 121 | _rfrom 122 | 123 | _ new_handle 124 | 125 | next 126 | endcode 127 | 128 | ; ### tuple>string 129 | code tuple_to_string, 'tuple>string' ; tuple-instance -> void 130 | _dup 131 | _ type_of ; -> tuple-instance type 132 | _ type_symbol 133 | _ symbol_name ; -> tuple-instance type-name 134 | _quote " tuple-instance type-name sbuf 136 | _tuck 137 | _ sbuf_append_string ; -> tuple-instance sbuf 138 | _quote " 0x" 139 | _over 140 | _ sbuf_append_string ; -> tuple-instance sbuf 141 | _swap 142 | _ object_address 143 | _ to_hex 144 | _over 145 | _ sbuf_append_string 146 | _lit tagged_char('>') 147 | _over 148 | _ sbuf_push 149 | _ sbuf_to_string 150 | next 151 | endcode 152 | -------------------------------------------------------------------------------- /src/recover.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2016-2020 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | %macro _rpfetch 0 19 | _dup 20 | mov rbx, rsp 21 | %endmacro 22 | 23 | %macro _rpstore 0 24 | mov rsp, rbx 25 | _drop 26 | %endmacro 27 | 28 | ; ### catch 29 | code catch, 'catch' ; quot -> ... f 30 | 31 | _rpfetch ; -> quot raw-rp 32 | 33 | _ current_thread 34 | _ thread_catchstack 35 | _ vector_push ; -> quot 36 | 37 | _ callable_raw_code_address 38 | mov rax, rbx 39 | _drop 40 | call rax 41 | 42 | _ current_thread 43 | _ thread_catchstack 44 | _ vector_pop_star 45 | 46 | ; no error 47 | _f 48 | 49 | next 50 | endcode 51 | 52 | ; ### throw 53 | code throw, 'throw' ; error -> 54 | 55 | cmp rbx, NIL 56 | jne .error 57 | _drop 58 | next 59 | 60 | .error: 61 | _ current_thread 62 | _ thread_catchstack 63 | _ vector_?pop 64 | 65 | cmp rbx, NIL 66 | je .no_catch 67 | 68 | ; -> saved-raw-rp 69 | _rpstore 70 | next 71 | 72 | .no_catch: ; -> error nil 73 | ; REVIEW 74 | _print "no catch" 75 | _drop ; -> error 76 | _ string? ; -> string/nil 77 | cmp rbx, NIL 78 | je .1 79 | _ error_output 80 | _ get 81 | _ stream_write_string 82 | .1: ; -> nil 83 | _ maybe_print_backtrace 84 | _ bye 85 | next 86 | endcode 87 | 88 | ; REVIEW 89 | asm_global error_object_, NIL 90 | 91 | ; ### last-error 92 | code last_error, 'last-error' ; void -> object/f 93 | _dup 94 | mov rbx, [error_object_] 95 | next 96 | endcode 97 | 98 | ; ### recover 99 | code recover, 'recover' ; try-quotation recover-quotion -> 100 | push rbx 101 | push qword [rbp] ; r: -> recover try 102 | _2drop 103 | 104 | _ get_datastack ; -> data-stack r: -> recover try 105 | 106 | pop rax ; -> data-stack r: -> recover rax: try 107 | 108 | push rbx ; -> data-stack r: -> recover data-stack 109 | 110 | mov rbx, rax ; -> try r: -> recover data-stack 111 | 112 | push r12 113 | push r13 114 | push r14 115 | push r15 116 | 117 | _ catch 118 | 119 | pop r15 120 | pop r14 121 | pop r13 122 | pop r12 123 | 124 | cmp rbx, NIL 125 | jne .error 126 | 127 | ; no error 128 | _drop ; r: -> recover data-stack 129 | add rsp, BYTES_PER_CELL * 2 130 | next 131 | 132 | .error: 133 | ; -> error-object r: -> recover data-stack 134 | mov [error_object_], rbx 135 | 136 | ; restore data stack 137 | _ clear 138 | _rfrom 139 | _tick identity 140 | _ each 141 | 142 | _dup 143 | mov rbx, [error_object_] 144 | 145 | _rfrom ; -> recover-quot 146 | 147 | _ callable_raw_code_address 148 | mov rax, rbx 149 | _drop 150 | call rax 151 | 152 | next 153 | endcode 154 | -------------------------------------------------------------------------------- /src/keyword.asm: -------------------------------------------------------------------------------- 1 | ; Copyright (C) 2017-2020 Peter Graves 2 | 3 | ; This program is free software: you can redistribute it and/or modify 4 | ; it under the terms of the GNU General Public License as published by 5 | ; the Free Software Foundation, either version 3 of the License, or 6 | ; (at your option) any later version. 7 | 8 | ; This program is distributed in the hope that it will be useful, 9 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ; GNU General Public License for more details. 12 | 13 | ; You should have received a copy of the GNU General Public License 14 | ; along with this program. If not, see . 15 | 16 | file __FILE__ 17 | 18 | ; 2 slots: object header, name 19 | 20 | asm_global keyword_hashtable_ 21 | 22 | code keyword_hashtable, 'keyword-hashtable' ; -> hashtable 23 | _dup 24 | mov rbx, [keyword_hashtable_] 25 | next 26 | endcode 27 | 28 | %macro _keyword_name 0 ; keyword -> name 29 | _slot1 30 | %endmacro 31 | 32 | %macro _this_keyword_set_name 0 ; name -> 33 | _this_set_slot1 34 | %endmacro 35 | 36 | ; ### keyword? 37 | code keyword?, 'keyword?' ; x -> ? 38 | _ deref ; -> raw-object/0 39 | test rbx, rbx 40 | jz .1 41 | _object_raw_typecode_eax 42 | cmp eax, TYPECODE_KEYWORD 43 | jne .1 44 | mov ebx, TRUE 45 | _return 46 | .1: 47 | mov ebx, NIL 48 | next 49 | endcode 50 | 51 | ; ### verify-keyword 52 | code verify_keyword, 'verify-keyword' ; keyword -> keyword 53 | _dup 54 | _ keyword? 55 | _tagged_if_not .1 56 | _ error_not_keyword 57 | _then .1 58 | next 59 | endcode 60 | 61 | ; ### check_keyword 62 | code check_keyword, 'check_keyword', SYMBOL_INTERNAL ; x -> keyword 63 | _dup 64 | _ deref 65 | test rbx, rbx 66 | jz .error 67 | _object_raw_typecode_eax 68 | cmp eax, TYPECODE_KEYWORD 69 | jne .error 70 | _nip 71 | next 72 | .error: 73 | _drop 74 | _ error_not_keyword 75 | next 76 | endcode 77 | 78 | ; ### string->keyword 79 | code string_to_keyword, 'string->keyword' ; string -> keyword 80 | 81 | _lit 2 82 | _ raw_allocate_cells ; -> name raw-object-address 83 | 84 | push this_register 85 | mov this_register, rbx 86 | 87 | mov rbx, [rbp] ; -> name name 88 | 89 | _this_object_set_raw_typecode TYPECODE_KEYWORD 90 | 91 | _this_keyword_set_name ; -> name 92 | 93 | _dup 94 | mov rbx, this_register ; -> name keyword 95 | pop this_register 96 | 97 | _ new_handle ; -> name handle 98 | 99 | _swap 100 | _dupd ; -> handle handle name 101 | _ keyword_hashtable 102 | _ hashtable_set_at ; -> handle 103 | 104 | next 105 | endcode 106 | 107 | ; ### intern-keyword 108 | code intern_keyword, 'intern-keyword' ; string -> keyword 109 | _dup 110 | _ keyword_hashtable 111 | _ hashtable_at_star 112 | cmp rbx, NIL 113 | _drop 114 | je .not_found 115 | _nip 116 | next 117 | 118 | .not_found: ; -> string nil 119 | _drop ; -> string 120 | _ string_to_keyword ; -> keyword 121 | next 122 | endcode 123 | 124 | ; ### keyword-name 125 | code keyword_name, 'keyword-name' ; keyword -> name 126 | _ check_keyword 127 | _keyword_name 128 | next 129 | endcode 130 | 131 | ; ### keyword->string 132 | code keyword_to_string, 'keyword->string' ; keyword -> string 133 | _quote ":" 134 | _swap 135 | _ keyword_name 136 | _ string_append 137 | next 138 | endcode 139 | 140 | ; ### keyword-hashcode 141 | code keyword_hashcode, 'keyword-hashcode' ; keyword -> hashcode 142 | _ object_address 143 | _untag_fixnum 144 | shr rbx, 3 145 | _tag_fixnum 146 | next 147 | endcode 148 | -------------------------------------------------------------------------------- /feral/list-buffers.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: editor feral-core feline accessors modes key ; 17 | in: list-buffers 18 | 19 | private 20 | 21 | constant: name "List Buffers" ; 22 | 23 | constant: buffer-name-column 4 ; 24 | 25 | constant: buffer-directory-column 40 ; 26 | 27 | : list-buffers-select 28 | :buffer dot-line line-get-property :> selected-buffer 29 | current-buffer parent>> current-buffer! 30 | selected-buffer set-current-buffer 31 | true repaint?! 32 | update-display ; 33 | 34 | : list-buffers-delete 35 | :buffer dot-line line-get-property :> buf 36 | buf buffer-modified? [ 37 | "Buffer is modified" message 38 | ] [ 39 | buffer-list vector? assert 40 | buffer-list [ buf eq? ] find // -> index/nil element/nil 41 | [ 42 | // -> index 43 | buffer-list vector-remove-nth! 44 | 45 | delete-line-internal 46 | buffer-name-column dot-offset! 47 | mod-count mod-count-last-save! 48 | update-display 49 | ] when 50 | ] if ; 51 | 52 | : list-buffers-quit 53 | current-buffer parent>> current-buffer! 54 | true repaint?! 55 | update-display ; 56 | 57 | global list-buffers-local-map 58 | 59 | : initialize-local-map 60 | 128 :> keymap 61 | ' list-buffers-select feral-key:enter keymap set-at 62 | ' list-buffers-delete feral-key:delete keymap set-at 63 | ' list-buffers-quit feral-key:escape keymap set-at 64 | ' list-buffers-quit feral-key:ctrl-w keymap set-at 65 | keymap list-buffers-local-map! ; 66 | 67 | initialize-local-map 68 | 69 | feral-config:gtkui? #if 70 | ' list-buffers-delete feral-key:kp-delete list-buffers-local-map set-at 71 | #endif 72 | 73 | feral-config:winui? feral-config:gtkui? or #if 74 | ' list-buffers-select feral-key:double-mouse-1 list-buffers-local-map set-at 75 | #endif 76 | 77 | : list-buffers 78 | current-buffer name>> name eq? ?exit 79 | 80 | make-buffer :> buf 81 | name buf name<< 82 | current-buffer-directory buf directory<< 83 | list-buffers-local-map buf local-map<< 84 | 85 | current-buffer in-buffer-list? [ current-buffer ] [ current-buffer parent>> ] if 86 | :> parent-buffer 87 | 88 | parent-buffer in-buffer-list? assert 89 | 90 | local b 91 | local sb 92 | local parent-buffer-line 93 | local line 94 | buffer-list [ 95 | b! 96 | 128 sb! 97 | 98 | b current-buffer eq? '.' '\s' ? sb sbuf-push 99 | b read-only>> 'r' '\s' ? sb sbuf-push 100 | b buffer-modified? '*' '\s' ? sb sbuf-push 101 | '\s' sb push 102 | b buffer-name sb sbuf-append-string 103 | 104 | b filename>> [ 105 | directory? [ 106 | '\s' sb push 107 | [ sb length buffer-directory-column < ] [ '\s' sb push ] while 108 | b directory>> sb sbuf-append-string 109 | ] unless 110 | ] when* 111 | 112 | sb sbuf>string make-line/1 line! 113 | b :buffer line line-set-property 114 | line buf buffer-append-line 115 | 116 | b parent-buffer eq? [ buf last-line>> parent-buffer-line! ] when 117 | ] each 118 | 119 | parent-buffer buf parent<< 120 | 121 | true buf read-only<< 122 | 123 | buf first-line>> buf top-line<< 124 | 125 | parent-buffer-line buf first-line>> or // line 126 | buffer-name-column // column 127 | make-position buf dot<< 128 | 129 | buffer-name-column buf goal-column<< 130 | 131 | buf current-buffer! 132 | renumber 133 | true repaint?! ; 134 | 135 | in: editor 136 | 137 | public 138 | 139 | : list-buffers 140 | list-buffers:list-buffers ; 141 | -------------------------------------------------------------------------------- /feral/termui-key.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2017-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline ; 17 | in: feral-key 18 | 19 | feral-config:termui? assert 20 | 21 | public 22 | 23 | constant: ctrl-a 0x01 code-char ; 24 | constant: ctrl-b 0x02 code-char ; 25 | constant: ctrl-c 0x03 code-char ; 26 | constant: ctrl-d 0x04 code-char ; 27 | constant: ctrl-e 0x05 code-char ; 28 | constant: ctrl-f 0x06 code-char ; 29 | constant: ctrl-g 0x07 code-char ; 30 | constant: ctrl-h 0x08 code-char ; 31 | constant: ctrl-i 0x09 code-char ; 32 | constant: ctrl-j 0x0a code-char ; 33 | constant: ctrl-k 0x0b code-char ; 34 | constant: ctrl-l 0x0c code-char ; 35 | constant: ctrl-m 0x0d code-char ; 36 | constant: ctrl-n 0x0e code-char ; 37 | constant: ctrl-o 0x0f code-char ; 38 | constant: ctrl-p 0x10 code-char ; 39 | constant: ctrl-q 0x11 code-char ; 40 | constant: ctrl-r 0x12 code-char ; 41 | constant: ctrl-s 0x13 code-char ; 42 | constant: ctrl-t 0x14 code-char ; 43 | constant: ctrl-u 0x15 code-char ; 44 | constant: ctrl-v 0x16 code-char ; 45 | constant: ctrl-w 0x17 code-char ; 46 | constant: ctrl-x 0x18 code-char ; 47 | constant: ctrl-y 0x19 code-char ; 48 | constant: ctrl-z 0x1a code-char ; 49 | 50 | constant: tab 0x09 code-char ; 51 | constant: escape 0x1b code-char ; 52 | constant: del 0x7f code-char ; 53 | 54 | win64? #if 55 | constant: backspace 0x08 code-char ; 56 | constant: ctrl-backspace 0x7f code-char ; 57 | constant: enter 0x0d code-char ; 58 | #else 59 | constant: backspace 0x7f code-char ; 60 | constant: ctrl-backspace 0x08 code-char ; 61 | constant: enter 0x0a code-char ; 62 | #endif 63 | 64 | win64? #if 65 | constant: delete 0x8053 ; 66 | constant: home 0x8047 ; 67 | constant: end 0x804f ; 68 | constant: left 0x804b ; 69 | constant: right 0x804d ; 70 | constant: up 0x8048 ; 71 | constant: down 0x8050 ; 72 | constant: pageup 0x8049 ; 73 | constant: pagedown 0x8051 ; 74 | constant: ctrl-delete 0x8093 ; 75 | constant: ctrl-home 0x8077 ; 76 | constant: ctrl-end 0x8075 ; 77 | constant: ctrl-up 0x808d ; 78 | constant: ctrl-down 0x8091 ; 79 | constant: ctrl-left 0x8073 ; 80 | constant: ctrl-right 0x8074 ; 81 | constant: alt-left 0x809b ; 82 | constant: alt-right 0x809d ; 83 | constant: f3 0x803d ; 84 | constant: shift-f3 0x8056 ; 85 | constant: ctrl-f3 0x8060 ; 86 | constant: f6 0x8040 ; 87 | constant: f11 0x8085 ; 88 | constant: shift-f11 0x8087 ; 89 | constant: f12 0x8086 ; 90 | constant: shift-f12 0x8088 ; 91 | #endif 92 | 93 | linux? #if 94 | constant: delete 0x1b5b337e ; 95 | constant: home 0x1b5b48 ; 96 | constant: end 0x1b5b46 ; 97 | constant: left 0x1b5b44 ; 98 | constant: right 0x1b5b43 ; 99 | constant: up 0x1b5b41 ; 100 | constant: down 0x1b5b42 ; 101 | constant: pageup 0x1b5b357e ; 102 | constant: pagedown 0x1b5b367e ; 103 | constant: ctrl-delete 0x1b5b333b357e ; 104 | constant: ctrl-home 0x1b5b313b3548 ; 105 | constant: ctrl-end 0x1b5b313b3546 ; 106 | constant: ctrl-up 0x1b5b313b3541 ; 107 | constant: ctrl-down 0x1b5b313b3542 ; 108 | constant: ctrl-right 0x1b5b313b3543 ; 109 | constant: ctrl-left 0x1b5b313b3544 ; 110 | constant: alt-left 0x1b5b313b3344 ; 111 | constant: alt-right 0x1b5b313b3343 ; 112 | constant: f3 0x1b4f52 ; 113 | constant: shift-f3 0x1b5b313b3252 ; 114 | constant: ctrl-f3 0x1b5b313b3552 ; 115 | constant: f6 0x1b5b31377e ; 116 | constant: f11 0x1b5b32337e ; 117 | constant: shift-f11 0x1b5b32333b327e ; 118 | constant: f12 0x1b5b32347e ; 119 | constant: shift-f12 0x1b5b32343b327e ; 120 | #endif 121 | 122 | // Linux only 123 | constant: shift-tab 0x1b5b5a ; 124 | constant: shift-home 0x1b5b313b3248 ; 125 | constant: shift-end 0x1b5b313b3246 ; 126 | -------------------------------------------------------------------------------- /feral/search-mode.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2019-2020 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: feline accessors feral-core segments feral-colors ; 17 | in: search-mode 18 | 19 | private 20 | 21 | global instance 22 | 23 | use: regex 24 | 25 | : search-mode-format-line ( line ) // line -> segments 26 | 27 | :search current-buffer buffer-get-property :> search 28 | search nil? ?exit 29 | 30 | search pattern>> :> pattern 31 | 32 | line text>> detab :> text 33 | 34 | 16 make-vector :> v 35 | 36 | :search-results-header line line-get-property [ 37 | ": " text substring-start !> n 38 | n [ 39 | n 2 &+ n! 40 | n text string-head 0 color-header make-segment/3 v push 41 | n text string-tail n color-text make-segment/3 v push 42 | ] [ 43 | text 0 color-header make-segment/3 v push 44 | ] if 45 | v 46 | ] ?return 47 | 48 | [ :source-file line line-get-property ] 49 | [ :source-line-number line line-get-property nil? ] both? 50 | [ text 0 color-filename make-segment/3 v push v ] ?return 51 | 52 | 0 !> i 53 | 54 | local j 55 | local k 56 | 57 | ':' text string-index [ 58 | 1+ i! // include ':' in segment 59 | 0 i text substring 0 color-linenumber make-segment/3 v push 60 | ] when* 61 | 62 | search regex>> [ 63 | [ 64 | pattern text i 65 | find-regex-from // -> index1/nil index2/nil 66 | k! j! 67 | j 68 | ] [ 69 | i j text substring i color-text make-segment/3 v push 70 | j k text substring j color-name make-segment/3 v push 71 | k i! 72 | ] while 73 | ] [ 74 | [ 75 | search whole-words-only>> [ 76 | pattern text i find-word-from 77 | ] [ 78 | search text i search-find-substring-from 79 | ] if 80 | dup j! 81 | ] [ 82 | i j text substring i color-text make-segment/3 v push 83 | j dup pattern length + text substring j color-name make-segment/3 v push 84 | j pattern length + i! 85 | ] while 86 | ] if 87 | 88 | i text length < [ 89 | i text length text substring i color-text make-segment/3 v push 90 | ] when 91 | 92 | v ; 93 | 94 | unuse: regex 95 | 96 | : search-mode-goto-source 97 | :search current-buffer buffer-get-property :> search 98 | 99 | :source-line-number dot-line line-get-property :> linenumber 100 | :source-offset dot-line line-get-property :> offset 101 | 102 | editor:switch-to-parent-buffer 103 | linenumber editor:goto-line-internal 104 | 105 | offset [ 106 | offset dot-offset! 107 | search [ 108 | dot-line 109 | dot-offset search pattern>> length + 110 | make-position mark! 111 | 112 | // put dot after mark 113 | dot mark dot! mark! 114 | ] when 115 | ] when 116 | 117 | true repaint?! ; 118 | 119 | global search-mode-local-map 120 | 121 | : initialize-local-map 122 | 128 :> m 123 | ' editor:kill-buffer feral-key:escape m set-at 124 | ' search-mode-goto-source feral-key:enter m set-at 125 | m search-mode-local-map! ; 126 | 127 | initialize-local-map 128 | 129 | feral-config:winui? #if 130 | ' search-mode-goto-source feral-key:double-mouse-1 search-mode-local-map set-at 131 | #endif 132 | 133 | : search-mode-initialize-buffer // buffer -> void 134 | 1 ?enough :> buf 135 | search-mode-local-map buf local-map<< ; 136 | 137 | : initialize-search-mode 138 | mode make-instance :> m 139 | "search" m name<< 140 | ' search-mode-initialize-buffer m initialize-buffer-function<< 141 | ' search-mode-format-line m format-line-function<< 142 | m instance! ; 143 | 144 | initialize-search-mode 145 | 146 | public 147 | 148 | : get-instance // void -> mode 149 | instance ; 150 | -------------------------------------------------------------------------------- /feral/disassembly-mode.feline: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2020-2021 Peter Graves 2 | 3 | // This program is free software: you can redistribute it and/or modify 4 | // it under the terms of the GNU General Public License as published by 5 | // the Free Software Foundation, either version 3 of the License, or 6 | // (at your option) any later version. 7 | 8 | // This program is distributed in the hope that it will be useful, 9 | // but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | // GNU General Public License for more details. 12 | 13 | // You should have received a copy of the GNU General Public License 14 | // along with this program. If not, see . 15 | 16 | using: disassembler feral-core feline accessors segments feral-colors ; 17 | in: disassembly-mode 18 | 19 | empty 20 | 21 | private 22 | 23 | global instance 24 | 25 | global local-map 26 | 27 | : disassemble-component // string -> string 28 | 1 ?enough verify-string :> token 29 | make-string-output-stream :> stream 30 | [ 31 | stream standard-output set 32 | token d/1 33 | ] with-dynamic-scope 34 | stream string-output-stream-string // -> string 35 | stream close ; 36 | 37 | : disassemble-thing-at-dot 38 | dot-line-text :> s 39 | s tokenize :> tokens 40 | local output 41 | tokens [ "call" = ] find [ 42 | // -> index 43 | 1+ tokens ?nth [ 44 | disassemble-component output! 45 | ] when* 46 | ] when 47 | 48 | output nil? ?exit 49 | 50 | current-buffer :> buf 51 | local divider 52 | output length 0> [ 53 | "" 0 make-line/2 dup divider! buf buffer-append-line 54 | output string-lines [ make-line/1 buf buffer-append-line ] each 55 | renumber 56 | editor:add-undo-move 57 | divider next>> 0 move-dot-to 58 | "0x" dot-line-text string-has-prefix? [ 59 | :header :format dot-line line-set-property 60 | ] unless 61 | maybe-reframe 62 | true repaint?! 63 | ] [ "No output" message ] if ; 64 | 65 | : initialize-local-map 66 | 128 :> m 67 | ' editor:kill-buffer feral-key:escape m set-at 68 | ' disassemble-thing-at-dot feral-key:enter m set-at 69 | m local-map! ; 70 | 71 | initialize-local-map 72 | 73 | feral-config:winui? feral-config:gtkui? or #if 74 | ' disassemble-thing-at-dot feral-key:double-mouse-1 local-map set-at 75 | #endif 76 | 77 | : format-line ( line ) // line -> segments 78 | line text>> :> s 79 | :format line line-get-property :> format 80 | { 81 | { [ format :header eq? ] [ color-filename ] } 82 | { [ "0x" s string-has-prefix? ] [ color-text ] } 83 | [ color-comment ] 84 | } cond :> color 85 | s 0 color make-segment/3 1array ; 86 | 87 | : initialize-buffer // buffer -> void 88 | 1 ?enough :> buf 89 | local-map buf local-map<< ; 90 | 91 | : initialize-mode 92 | mode make-instance :> m 93 | "Feline disassembly" m name<< 94 | ' initialize-buffer m initialize-buffer-function<< 95 | ' format-line m format-line-function<< 96 | m instance! ; 97 | 98 | initialize-mode 99 | 100 | : disassemble 101 | execute-command-input-string :> command 102 | 103 | command tokenize :> tokens 104 | 105 | tokens length 2 < ?exit 106 | 107 | tokens first { "disassemble" "dis" } member? assert 108 | 109 | tokens second disassemble-component :> output 110 | 111 | local buf 112 | 113 | output length 0> [ 114 | make-buffer buf! 115 | 116 | output buf editor:buffer-set-contents 117 | command buf command<< 118 | command buf name<< 119 | 120 | // REVIEW 121 | current-buffer directory>> buf directory<< 122 | 123 | true buf read-only<< 124 | buf first-line>> 0 make-position buf dot<< 125 | nil buf mark<< 126 | buf first-line>> buf top-line<< 127 | 128 | "0x" buf first-line>> text>> string-has-prefix? [ 129 | :header :format buf first-line>> line-set-property 130 | ] unless 131 | 132 | current-buffer buf parent<< 133 | instance buf mode<< 134 | instance initialize-buffer-function>> [ buf swap call ] when* 135 | 136 | buf in-buffer-list? [ buf buffer-list vector-push ] unless 137 | buf set-current-buffer 138 | 139 | true repaint?! 140 | ] [ 141 | "No output" message 142 | ] if ; 143 | 144 | in: feral-commands 145 | 146 | public 147 | 148 | : disassemble disassembly-mode:disassemble ; 149 | 150 | : dis disassembly-mode:disassemble ; 151 | --------------------------------------------------------------------------------